[m-rev.] diff: minor fix for parallel mmc make

[Peter Wang]

Branches: main

compiler/make.util.m:
        In parallel mmc --make, when a child thread terminates with an error,
        wait for all currently running children to terminate before letting
        the parent thread return.  (The running children may be performing
        I/O.)

Index: compiler/make.util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.util.m,v
retrieving revision 1.42
diff -u -r1.42 make.util.m
--- compiler/make.util.m        13 Feb 2007 00:16:55 -0000      1.42
+++ compiler/make.util.m        13 Feb 2007 00:45:55 -0000
@@ -394,7 +394,8 @@
     list.foldl(run_in_child(ChildExits, MakeTarget, Info), InitialTargets,
         !IO),
     parent_loop(ChildExits, KeepGoing, MakeTarget, Info,
-        length(Targets), LaterTargets, yes, Success, no, MaybeExcp, !IO),
+        length(InitialTargets), LaterTargets, yes, Success, no, MaybeExcp,
+        !IO),
     %
     % Rethrow the first of any exceptions which terminated a child thread.
     %
@@ -410,9 +411,14 @@
     Info::in, int::in, list(T)::in, bool::in, bool::out,
     maybe(univ)::in, maybe(univ)::out, io::di, io::uo) is det.

-parent_loop(ChildExits, KeepGoing, MakeTarget, Info, ChildrenLeft, Targets,
+parent_loop(ChildExits, KeepGoing, MakeTarget, Info, ChildrenRunning0, Targets,
         !Success, !MaybeExcp, !IO) :-
-    ( ChildrenLeft = 0 ->
+    (
+        % We are done once all running children have terminated and there are
+        % no more targets to make.
+        ChildrenRunning0 = 0,
+        Targets = []
+    ->
         true
     ;
         % Wait for a running child to indicate that it is finished.
@@ -441,15 +447,20 @@
             !:Success = !.Success `and` NewSuccess,
             (
                 Targets = [],
-                MoreTargets = []
+                MoreTargets = [],
+                ChildrenRunning = ChildrenRunning0 - 1
             ;
                 Targets = [NextTarget | MoreTargets],
-                run_in_child(ChildExits, MakeTarget, Info, NextTarget, !IO)
+                run_in_child(ChildExits, MakeTarget, Info, NextTarget, !IO),
+                ChildrenRunning = ChildrenRunning0
             ),
             parent_loop(ChildExits, KeepGoing, MakeTarget, Info,
-                ChildrenLeft-1, MoreTargets, !Success, !MaybeExcp, !IO)
+                ChildrenRunning, MoreTargets, !Success, !MaybeExcp, !IO)
         ;
-            !:Success = no
+            % Wait for the other running children to terminate before
+            % returning.
+            !:Success = no,
+            wait_for_running_children(ChildExits, ChildrenRunning0 - 1, !IO)
         )
     ).

@@ -477,6 +488,17 @@
         ), !IO)
     ).

+:- pred wait_for_running_children(child_exits::in, int::in, io::di, io::uo)
+    is det.
+
+wait_for_running_children(ChildExits, Num, !IO) :-
+    ( Num > 0 ->
+        channel.take(ChildExits, _Exit, !IO),
+        wait_for_running_children(ChildExits, Num-1, !IO)
+    ;
+        true
+    ).
+
 %-----------------------------------------------------------------------------%

 build_with_module_options_and_output_redirect(ModuleName, ExtraOptions,


--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to:       mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions:          mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------