Protect the predicate with_mutex/2 by using a mutex when updating the internal database. Also, use catch/3 instead of call_cleanup/2 as the later still seems to be buggy.
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1772 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
parent
0cef3c5389
commit
c837589385
@ -29,7 +29,9 @@
|
|||||||
'$init_thread0' :-
|
'$init_thread0' :-
|
||||||
'$create_mq'(0),
|
'$create_mq'(0),
|
||||||
'$record_thread_info'(0, main, [0, 0, 0], false, '$init_thread0'),
|
'$record_thread_info'(0, main, [0, 0, 0], false, '$init_thread0'),
|
||||||
recorda('$thread_defaults', [0, 0, 0, false], _).
|
recorda('$thread_defaults', [0, 0, 0, false], _),
|
||||||
|
'$new_mutex'(Id),
|
||||||
|
recorda('$with_mutex_mutex',Id,_).
|
||||||
|
|
||||||
'$top_thread_goal'(G, Detached) :-
|
'$top_thread_goal'(G, Detached) :-
|
||||||
'$thread_self'(Id),
|
'$thread_self'(Id),
|
||||||
@ -390,17 +392,24 @@ with_mutex(M, G) :-
|
|||||||
var(G), !,
|
var(G), !,
|
||||||
'$do_error'(instantiation_error,with_mutex(M, G)).
|
'$do_error'(instantiation_error,with_mutex(M, G)).
|
||||||
with_mutex(M, G) :-
|
with_mutex(M, G) :-
|
||||||
\+ callable(G),
|
\+ callable(G), !,
|
||||||
'$do_error'(type_error(callable,G),with_mutex(M, G)).
|
'$do_error'(type_error(callable,G),with_mutex(M, G)).
|
||||||
with_mutex(M, G) :-
|
with_mutex(M, G) :-
|
||||||
atom(M), !,
|
atom(M), !,
|
||||||
|
recorded('$with_mutex_mutex',WMId,_),
|
||||||
|
'$lock_mutex'(WMId),
|
||||||
( recorded('$mutex',[M|Id],_) ->
|
( recorded('$mutex',[M|Id],_) ->
|
||||||
true
|
true
|
||||||
; '$new_mutex'(Id),
|
; '$new_mutex'(Id),
|
||||||
recorda('$mutex',[M|Id],_)
|
recorda('$mutex',[M|Id],_)
|
||||||
),
|
),
|
||||||
|
'$unlock_mutex'(WMId),
|
||||||
'$lock_mutex'(Id),
|
'$lock_mutex'(Id),
|
||||||
call_cleanup(once(G), '$unlock_mutex'(Id)).
|
( catch('$execute'(G), E, ('$unlock_mutex'(Id), throw(E))) ->
|
||||||
|
'$unlock_mutex'(Id)
|
||||||
|
; '$unlock_mutex'(Id),
|
||||||
|
fail
|
||||||
|
).
|
||||||
with_mutex(M, G) :-
|
with_mutex(M, G) :-
|
||||||
'$do_error'(type_error(atom,M),with_mutex(M, G)).
|
'$do_error'(type_error(atom,M),with_mutex(M, G)).
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user