diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixes for message queues

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2208 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2008-04-04 11:28:59 +00:00
parent 4c933b8d79
commit 21f03da2cd
1 changed files with 29 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
pl/threads.yap
View File

@ -566,8 +566,8 @@ message_queue_create(Id, []) :- !,
'$global_queue_mutex'(QMutex), '$global_queue_mutex'(QMutex),
'$new_mutex'(Mutex), '$new_mutex'(Mutex),
'$cond_create'(Cond), '$cond_create'(Cond),
'$mq_new_id'(Id), '$mq_new_id'(Id, NId, Key),
recorda('$queue',q(Id,Mutex,Cond,Id), _), recorda('$queue',q(Id,Mutex,Cond,NId,Key), _),
'$unlock_mutex'(QMutex). '$unlock_mutex'(QMutex).
message_queue_create(Id, [alias(Alias)]) :- message_queue_create(Id, [alias(Alias)]) :-
var(Alias), !, var(Alias), !,
@ -580,14 +580,14 @@ message_queue_create(Id, [alias(Alias)]) :- !,
'$lock_mutex'(QMutex), '$lock_mutex'(QMutex),
'$new_mutex'(Mutex), '$new_mutex'(Mutex),
'$cond_create'(Cond), '$cond_create'(Cond),
( recorded('$queue', q(Alias,_,_,_), _) -> ( recorded('$queue', q(Alias,_,_,_,_), _) ->
'$unlock_mutex'(QMutex), '$unlock_mutex'(QMutex),
'$do_error'(permission_error(create,queue,alias(Alias)),message_queue_create(Id, [alias(Alias)])) '$do_error'(permission_error(create,queue,alias(Alias)),message_queue_create(Id, [alias(Alias)]))
; recorded('$thread_alias', [_|Alias], _) -> ; recorded('$thread_alias', [_|Alias], _) ->
'$unlock_mutex'(QMutex), '$unlock_mutex'(QMutex),
'$do_error'(permission_error(create,queue,alias(Alias)),message_queue_create(Id, [alias(Alias)])) '$do_error'(permission_error(create,queue,alias(Alias)),message_queue_create(Id, [alias(Alias)]))
; '$mq_new_id'(Id), ; '$mq_new_id'(Id, NId, Key),
recorda('$queue',q(Alias,Mutex,Cond,Id), _), recorda('$queue',q(Alias,Mutex,Cond,NId,Key), _),
'$unlock_mutex'(QMutex) '$unlock_mutex'(QMutex)
). ).
message_queue_create(Id, [Option| _]) :- message_queue_create(Id, [Option| _]) :-
@ -603,23 +603,29 @@ message_queue_create(Id) :-
; '$do_error'(type_error(variable, Id), message_queue_create(Id)) ; '$do_error'(type_error(variable, Id), message_queue_create(Id))
). ).
'$create_thread_mq'(Tid) :- '$create_thread_mq'(TId) :-
'$global_queue_mutex'(QMutex), '$global_queue_mutex'(QMutex),
'$new_mutex'(Mutex), '$new_mutex'(Mutex),
'$cond_create'(Cond), '$cond_create'(Cond),
'$mq_new_id'(Id), '$mq_new_id'(TId, TId, Key),
recorda('$queue', q(Tid,Mutex,Cond,Id), _), recorda('$queue', q(TId,Mutex,Cond,TId,Key), _),
'$unlock_mutex'(QMutex). '$unlock_mutex'(QMutex).
'$mq_new_id'('$message_queue'(I)) :- '$mq_new_id'(Id, Id, AtId) :-
'$integers'(I), integer(Id), !,
\+ recorded('$queue', q(_,_,_,'$message_queue'(I)), _), \+ recorded('$queue', q(_,_,_,Id,_), _),
atomic_concat('$queue__',Id,AtId),
!.
'$mq_new_id'(_, Id, AtId) :-
'$integers'(Id),
\+ recorded('$queue', q(_,_,_,Id,_), _),
atomic_concat('$queue__',Id,AtId),
!. !.
'$integers'(0). '$integers'(-1).
'$integers'(I) :- '$integers'(I) :-
'$integers'(I1), '$integers'(I1),
I is I1+1. I is I1-1.
message_queue_destroy(Name) :- message_queue_destroy(Name) :-
@ -628,12 +634,12 @@ message_queue_destroy(Name) :-
message_queue_destroy(Queue) :- message_queue_destroy(Queue) :-
'$global_queue_mutex'(QMutex), '$global_queue_mutex'(QMutex),
'$lock_mutex'(QMutex), '$lock_mutex'(QMutex),
recorded('$queue',q(Queue,Mutex,Cond,CName),R), !, recorded('$queue',q(Queue,Mutex,Cond,_,QKey),R), !,
erase(R), erase(R),
'$cond_destroy'(Cond), '$cond_destroy'(Cond),
'$destroy_mutex'(Mutex), '$destroy_mutex'(Mutex),
'$unlock_mutex'(QMutex), '$unlock_mutex'(QMutex),
'$clean_mqueue'(CName). '$clean_mqueue'(QKey).
message_queue_destroy(Queue) :- message_queue_destroy(Queue) :-
'$global_queue_mutex'(QMutex), '$global_queue_mutex'(QMutex),
'$unlock_mutex'(QMutex), '$unlock_mutex'(QMutex),
@ -652,7 +658,7 @@ message_queue_destroy(Name) :-
message_queue_property(Id, Prop) :- message_queue_property(Id, Prop) :-
( nonvar(Id) -> ( nonvar(Id) ->
'$check_message_queue_or_alias'(Id, message_queue_property(Id, Prop)) '$check_message_queue_or_alias'(Id, message_queue_property(Id, Prop))
; recorded('$queue', q(Id,_,_,_), _) ; recorded('$queue', q(Id,_,_,_,_), _)
), ),
'$check_message_queue_property'(Prop, message_queue_property(Id, Prop)), '$check_message_queue_property'(Prop, message_queue_property(Id, Prop)),
'$message_queue_id_alias'(Id0, Id), '$message_queue_id_alias'(Id0, Id),
@ -666,16 +672,16 @@ message_queue_property(Id, Prop) :-
Term \= '$message_queue'(_), !, Term \= '$message_queue'(_), !,
'$do_error'(domain_error(queue_or_alias, Term), Goal). '$do_error'(domain_error(queue_or_alias, Term), Goal).
'$check_message_queue_or_alias'('$message_queue'(I), Goal) :- '$check_message_queue_or_alias'('$message_queue'(I), Goal) :-
\+ recorded('$queue', q(_,_,_,'$message_queue'(I)), _), !, \+ recorded('$queue', q(_,_,_,I,_), _), !,
'$do_error'(existence_error(queue, '$message_queue'(I)), Goal). '$do_error'(existence_error(queue, '$message_queue'(I)), Goal).
'$check_message_queue_or_alias'(Term, Goal) :- '$check_message_queue_or_alias'(Term, Goal) :-
atom(Term), atom(Term),
\+ recorded('$queue', q(Term,_,_,_), _), !, \+ recorded('$queue', q(Term,_,_,_,_), _), !,
'$do_error'(existence_error(queue, Term), Goal). '$do_error'(existence_error(queue, Term), Goal).
'$check_message_queue_or_alias'(_, _). '$check_message_queue_or_alias'(_, _).
'$message_queue_id_alias'(Id, Alias) :- '$message_queue_id_alias'(Id, Alias) :-
recorded('$queue', q(Alias,_,_,Id), _), !. recorded('$queue', q(Alias,_,_,Id,_), _), !.
'$message_queue_id_alias'(Id, Id). '$message_queue_id_alias'(Id, Id).
'$check_message_queue_property'(Term, _) :- '$check_message_queue_property'(Term, _) :-
@ -687,7 +693,7 @@ message_queue_property(Id, Prop) :-
'$do_error'(domain_error(queue_property, Term), Goal). '$do_error'(domain_error(queue_property, Term), Goal).
'$message_queue_property'(Id, alias(Alias)) :- '$message_queue_property'(Id, alias(Alias)) :-
recorded('$queue', q(Alias,Mutex,Cond,Id), _). recorded('$queue', q(Alias,_,_,Id,_), _).
thread_send_message(Term) :- thread_send_message(Term) :-
@ -702,7 +708,7 @@ thread_send_message(Queue, Term) :-
thread_send_message(Queue, Term) :- thread_send_message(Queue, Term) :-
'$global_queue_mutex'(QMutex), '$global_queue_mutex'(QMutex),
'$lock_mutex'(QMutex), '$lock_mutex'(QMutex),
recorded('$queue',q(Queue,Mutex,Cond,Key),_), !, recorded('$queue',q(Queue,Mutex,Cond,_,Key),_), !,
'$lock_mutex'(Mutex), '$lock_mutex'(Mutex),
'$unlock_mutex'(QMutex), '$unlock_mutex'(QMutex),
recordz(Key,Term,_), recordz(Key,Term,_),
@ -725,7 +731,7 @@ thread_get_message(Queue, Term) :-
thread_get_message(Queue, Term) :- thread_get_message(Queue, Term) :-
'$global_queue_mutex'(QMutex), '$global_queue_mutex'(QMutex),
'$lock_mutex'(QMutex), '$lock_mutex'(QMutex),
recorded('$queue',q(Queue,Mutex,Cond,Key),_), !, recorded('$queue',q(Queue,Mutex,Cond,_,Key),_), !,
'$lock_mutex'(Mutex), '$lock_mutex'(Mutex),
'$unlock_mutex'(QMutex), '$unlock_mutex'(QMutex),
'$thread_get_message_loop'(Key, Term, Mutex, Cond). '$thread_get_message_loop'(Key, Term, Mutex, Cond).
@ -755,7 +761,7 @@ thread_peek_message(Queue, Term) :-
thread_peek_message(Queue, Term) :- thread_peek_message(Queue, Term) :-
'$global_queue_mutex'(QMutex), '$global_queue_mutex'(QMutex),
'$lock_mutex'(QMutex), '$lock_mutex'(QMutex),
recorded('$queue',q(Queue,Mutex,_,Key),_), !, recorded('$queue',q(Queue,Mutex,_,_,Key),_), !,
'$lock_mutex'(Mutex), '$lock_mutex'(Mutex),
'$unlock_mutex'(QMutex), '$unlock_mutex'(QMutex),
'$thread_peek_message2'(Key, Term, Mutex). '$thread_peek_message2'(Key, Term, Mutex).