Changeset 4461 for trunk/compiler

Timestamp:

08/31/08 09:01:15 (4 months ago)

Author:

pmoura

Message:

Corrected a bug in the implementation of the threaded_once/1-2 built-in multi-threading predicates (use of detached threads could make the methods fail despite the success of the thread goals).

Files:

• trunk/compiler/logtalk.pl (modified) (7 diffs)

trunk/compiler/logtalk.pl

@@ -7625 +7625 @@
 
 
-'$lgt_tr_threaded_individual_goal'(TGoal, Queue, thread_create('$lgt_mt_threaded_call'(TGoal, Queue), Id, [at_exit('$lgt_mt_threaded_exit_handler'(Id, Queue))]), Id, id(Id, TGoal, _)).
+'$lgt_tr_threaded_individual_goal'(TGoal, Queue, thread_create('$lgt_mt_threaded_call'(TGoal, Queue), Id, [at_exit('$lgt_mt_exit_handler'(Id, Queue))]), Id, id(Id, TGoal, _)).
 
 
@@ -13152 +13152 @@
 
 
+% '$lgt_mt_dispatch_goal'(+atom, +object_identifier, +object_identifier, @callable, @nonvar)
+%
+% creates a thread for proving a goal (this predicate is called from within categories)
+
+'$lgt_mt_dispatch_goal'(Option, Goal, This, Self, Tag) :-
+    '$lgt_current_object_'(This, Queue, _, _, _, _, _, _, _, _, _, _, _) ->
+    '$lgt_mt_dispatch_goal'(Option, Queue, Goal, This, Self, Tag).
+
+
+
+% '$lgt_mt_dispatch_goal'(+atom, +message_queue, @callable, +object_identifier, +object_identifier, @nonvar)
+%
+% creates a thread for proving a goal
+
+'$lgt_mt_dispatch_goal'(ignore, _, Goal, _, _, _) :-
+    thread_create(catch(Goal, _, true), _, [detached(true)]).
+
+'$lgt_mt_dispatch_goal'(call, Queue, Goal, This, Self, Tag) :-
+    thread_create('$lgt_mt_non_det_goal'(Queue, Goal, This, Self, Tag), Id, []),
+    % wait until the thread created for proving the goal is ready before proceeding:
+    thread_get_message(Queue, '$lgt_non_det_ready'(Id)).
+
+'$lgt_mt_dispatch_goal'(once, Queue, Goal, This, Self, Tag) :-
+    thread_create('$lgt_mt_det_goal'(Queue, Goal, This, Self, Tag), Id, []),
+    % wait until the thread created for proving the goal is ready before proceeding:
+    thread_get_message(Queue, '$lgt_det_ready'(Id)).
+
+
+
 % '$lgt_mt_det_goal'(+atom, +callable, +object_identifier, +object_identifier, @nonvar)
 %
 % processes a deterministic message received by an object's message queue
 
-'$lgt_mt_det_goal'(Return, Goal, This, Self, Tag) :-
-    thread_self(DetId),
-    thread_send_message(Return, '$lgt_thread_id'(once, Goal, This, Self, Tag, DetId)),
+'$lgt_mt_det_goal'(Queue, Goal, This, Self, Tag) :-
+    thread_self(Id),
+    thread_send_message(Queue, '$lgt_thread_id'(once, Goal, This, Self, Tag, Id)),
     % signal that the thread running the goal is ready:
-    thread_send_message(Return, '$lgt_det_ready'(Goal, This, Self, Tag)),
-    (   catch(Goal, Error, (thread_send_message(Return, '$lgt_reply'(Goal, This, Self, Tag, Error, DetId)), Flag = error)) ->
-        (   var(Flag) ->
-            thread_send_message(Return, '$lgt_reply'(Goal, This, Self, Tag, success, DetId))
+    thread_send_message(Queue, '$lgt_det_ready'(Id)),
+    (   catch(Goal, Error, thread_send_message(Queue, '$lgt_reply'(Goal, This, Self, Tag, Error, Id))) ->
+        (   var(Error) ->
+            thread_send_message(Queue, '$lgt_reply'(Goal, This, Self, Tag, success, Id))
         ;   % Goal generated an exception, which was already reported
             true
         )
-    ;   thread_send_message(Return, '$lgt_reply'(Goal, This, Self, Tag, failure, DetId))
+    ;   thread_send_message(Queue, '$lgt_reply'(Goal, This, Self, Tag, failure, Id))
     ).
 
@@ -13176 +13205 @@
 % processes a non-deterministic message received by an object's message queue
 
-'$lgt_mt_non_det_goal'(Return, Goal, This, Self, Tag) :-
-    thread_self(NonDetId),
-    thread_send_message(Return, '$lgt_thread_id'(call, Goal, This, Self, Tag, NonDetId)),
+'$lgt_mt_non_det_goal'(Queue, Goal, This, Self, Tag) :-
+    thread_self(Id),
+    thread_send_message(Queue, '$lgt_thread_id'(call, Goal, This, Self, Tag, Id)),
     % signal that the thread running the goal is ready:
-    thread_send_message(Return, '$lgt_non_det_ready'(Goal, This, Self, Tag)),
-    (   catch(Goal, Error, (thread_send_message(Return, '$lgt_reply'(Goal, This, Self, Tag, Error, NonDetId)), Flag = error)),
-        (   var(Flag) ->
-            thread_send_message(Return, '$lgt_reply'(Goal, This, Self, Tag, success, NonDetId)),
+    thread_send_message(Queue, '$lgt_non_det_ready'(Id)),
+    (   catch(Goal, Error, thread_send_message(Queue, '$lgt_reply'(Goal, This, Self, Tag, Error, Id))),
+        (   var(Error) ->
+            thread_send_message(Queue, '$lgt_reply'(Goal, This, Self, Tag, success, Id)),
             thread_get_message(Message),
             (   Message == '$lgt_next' ->
@@ -13192 +13221 @@
             true
         )
-    ;   thread_send_message(Return, '$lgt_reply'(Goal, This, Self, Tag, failure, NonDetId))
-    ).
-
-
-
-% '$lgt_mt_dispatch_goal'(+atom, +object_identifier, +object_identifier, @callable, @tag)
-%
-% creates a thread for proving a goal (this predicate is called from within categories)
-
-'$lgt_mt_dispatch_goal'(Option, Goal, This, Self, Tag) :-
-    '$lgt_current_object_'(This, Queue, _, _, _, _, _, _, _, _, _, _, _) ->
-    '$lgt_mt_dispatch_goal'(Option, Queue, Goal, This, Self, Tag).
-
-
-
-% '$lgt_mt_dispatch_goal'(+atom, +message_queue, @callable, +object_identifier, +object_identifier, @tag)
-%
-% creates a thread for proving a goal
-
-'$lgt_mt_dispatch_goal'(ignore, _, Goal, _, _, _) :-
-    thread_create(catch(Goal, _, true), _, [detached(true)]).
-
-'$lgt_mt_dispatch_goal'(call, Queue, Goal, This, Self, Tag) :-
-    thread_create('$lgt_mt_non_det_goal'(Queue, Goal, This, Self, Tag), _, [detached(false)]),
-    % wait until the thread created for proving the goal is ready before proceeding:
-    thread_get_message(Queue, '$lgt_non_det_ready'(Goal, This, Self, Tag)).
-
-'$lgt_mt_dispatch_goal'(once, Queue, Goal, This, Self, Tag) :-
-    thread_create('$lgt_mt_det_goal'(Queue, Goal, This, Self, Tag), _, [detached(false)]),
-    % wait until the thread created for proving the goal is ready before proceeding:
-    thread_get_message(Queue, '$lgt_det_ready'(Goal, This, Self, Tag)).
+    ;   % no (more) solutions
+        thread_send_message(Queue, '$lgt_reply'(Goal, This, Self, Tag, failure, Id))
+    ).
 
 
@@ -13319 +13320 @@
 '$lgt_mt_threaded_call'(Goal, Queue) :-
     thread_self(Id),
-    (   Goal ->
+    (   call(Goal) ->
         thread_send_message(Queue, '$lgt_result'(Id, true(Goal)))
     ;   thread_send_message(Queue, '$lgt_result'(Id, false))
@@ -13326 +13327 @@
 
 
-% '$lgt_mt_threaded_exit_handler'(@nonvar, +message_queue_identifier)
+% '$lgt_mt_exit_handler'(@nonvar, +message_queue_identifier)
 %
 % error handler for threaded/1 individual thread calls; an error generated 
@@ -13333 +13334 @@
 % the worker thread
 
-'$lgt_mt_threaded_exit_handler'(Id, Queue) :-
+'$lgt_mt_exit_handler'(Id, Queue) :-
     thread_property(Id, status(exception(Error))),
     catch(thread_send_message(Queue, '$lgt_result'(Id, exception(Error))), _, thread_detach(Id)).