[m-rev.] for review: parallel mmc --make with processes

Peter Wang wangp at students.csse.unimelb.edu.au
Thu Aug 16 15:03:01 AEST 2007


Branches: main

Make parallel mmc --make work using processes as well as threads.  This means
the compiler doesn't need to be built in a .par grade for the --jobs option
to have an effect.

compiler/make.util.m:
	Generalise the existing parallel fold code to work with threads and
	processes.

compiler/process_util.m:
	Add a predicate to start running a child process without waiting for
	the child to finish.

	Add a predicate to wait for a child process to finish.

doc/user_guide.text:
	Update the documentation.

Index: doc/user_guide.texi
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/doc/user_guide.texi,v
retrieving revision 1.540
diff -u -r1.540 user_guide.texi
--- doc/user_guide.texi	13 Aug 2007 03:01:55 -0000	1.540
+++ doc/user_guide.texi	16 Aug 2007 04:57:25 -0000
@@ -8652,8 +8652,9 @@
 @findex --jobs
 With @samp{--make}, attempt to perform up to @samp{<n>} jobs
 concurrently for some tasks.
-For the option to take effect, the compiler must be built in a parallel
-grade.  In low-level C grades the number of threads is also limited by
+
+In low-level C grades with parallelism support,
+the number of threads is also limited by
 the @samp{-P} option in the @samp{MERCURY_OPTIONS} environment variable
 (see @ref{Environment}).
 
Index: compiler/make.util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/make.util.m,v
retrieving revision 1.48
diff -u -r1.48 make.util.m
--- compiler/make.util.m	12 Jul 2007 01:28:43 -0000	1.48
+++ compiler/make.util.m	16 Aug 2007 04:30:01 -0000
@@ -58,9 +58,9 @@
     %
     % Like foldl2_maybe_stop_at_error, but if parallel make is enabled, it
     % tries to perform a first pass that overlaps execution of P(elem) in
-    % separate threads.  Updates to !Info in the first pass are ignored.  If
-    % the first pass succeeds, a second sequential pass is made in which
-    % updates !Info are kept.  Hence it must be safe to execute P(elem)
+    % separate threads or processes.  Updates to !Info in the first pass are
+    % ignored.  If the first pass succeeds, a second sequential pass is made in
+    % which updates !Info are kept.  Hence it must be safe to execute P(elem)
     % concurrently, in any order, and multiple times.
     %
 :- pred foldl2_maybe_stop_at_error_maybe_parallel(bool::in,
@@ -300,6 +300,7 @@
 :- import_module analysis.
 :- import_module libs.compiler_util.
 :- import_module libs.handle_options.
+:- import_module libs.process_util.
 :- import_module parse_tree.prog_foreign.
 :- import_module transform_hlds.
 :- import_module transform_hlds.mmc_analysis.
@@ -307,17 +308,11 @@
 :- import_module char.
 :- import_module dir.
 :- import_module exception.
+:- import_module set.
 :- import_module thread.
 :- import_module thread.channel.
-:- import_module univ.
 :- import_module unit.
-
-:- type child_exit
-    --->    child_succeeded
-    ;       child_failed
-    ;       child_exception(univ).
-
-:- type child_exits == channel(child_exit).
+:- import_module univ.
 
 %-----------------------------------------------------------------------------%
 
@@ -371,19 +366,54 @@
     ).
 
 %-----------------------------------------------------------------------------%
+%
+% Parallel (concurrent) fold
+%
+
+:- type child_exit
+    --->    child_succeeded
+    ;       child_failed
+    ;       child_exception(univ).
+
+:- inst child_succeeded_or_failed
+    --->    child_succeeded
+    ;       child_failed.
+
+:- typeclass par_fold(PF) where [
+
+    % run_in_child(Pred, Info, T, Succeeded, !PF, !IO)
+    %
+    % Start executing Pred in a child thread/process.  Succeeded is `yes' iff
+    % the child was successfully spawned.
+    %
+    pred run_in_child(
+        foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
+        Info::in, T::in, bool::out, PF::in, PF::out, io::di, io::uo) is det,
+
+    % Block until a child exit code is received.
+    %
+    pred wait_for_child_exit(child_exit::out(child_succeeded_or_failed),
+        PF::in, PF::out, io::di, io::uo) is det
+].
 
 foldl2_maybe_stop_at_error_maybe_parallel(KeepGoing, MakeTarget, Targets,
         Success, !Info, !IO) :-
+    % First pass.
     globals.io_lookup_int_option(jobs, Jobs, !IO),
-    ( 
-        thread.can_spawn,
-        Jobs > 1
-    ->
-        foldl2_maybe_stop_at_error_parallel(KeepGoing, Jobs,
-            MakeTarget, Targets, Success0, !.Info, !IO)
+    ( Jobs > 1 ->
+        ( process_util.can_fork ->
+            foldl2_maybe_stop_at_error_parallel_processes(KeepGoing, Jobs,
+                MakeTarget, Targets, Success0, !.Info, !IO)
+        ; thread.can_spawn ->
+            foldl2_maybe_stop_at_error_parallel_threads(KeepGoing, Jobs,
+                MakeTarget, Targets, Success0, !.Info, !IO)
+        ;
+            Success0 = yes
+        )
     ;
         Success0 = yes
     ),
+    % Second pass (sequential).
     (
         Success0 = yes,
         foldl2_maybe_stop_at_error(KeepGoing, MakeTarget, Targets, Success,
@@ -393,61 +423,71 @@
         Success = no
     ).
 
-:- pred foldl2_maybe_stop_at_error_parallel(bool::in, int::in,
+:- pred do_parallel_foldl2(bool::in, int::in,
     foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
-    list(T)::in, bool::out, Info::in, io::di, io::uo) is det.
+    Info::in, list(T)::in, bool::out, PF::in, PF::out, io::di, io::uo)
+    is det <= par_fold(PF).
 
-foldl2_maybe_stop_at_error_parallel(KeepGoing, Jobs, MakeTarget, Targets,
-        Success, Info, !IO) :-
-    channel.init(ChildExits, !IO),
+do_parallel_foldl2(KeepGoing, Jobs, MakeTarget, Info, Targets, Success,
+        !PF, !IO) :-
     list.split_upto(Jobs, Targets, InitialTargets, LaterTargets),
-    list.foldl(run_in_child(ChildExits, MakeTarget, Info), InitialTargets,
-        !IO),
-    parent_loop(ChildExits, KeepGoing, MakeTarget, Info,
-        length(InitialTargets), LaterTargets, yes, Success, no, MaybeExcp,
-        !IO),
-    %
-    % Rethrow the first of any exceptions which terminated a child thread.
-    %
+    start_initial_child_jobs(KeepGoing, MakeTarget, Info, InitialTargets,
+        0, NumChildJobs, !PF, !IO),
+    ( NumChildJobs < length(InitialTargets) ->
+        Success0 = no
+    ;
+        Success0 = yes
+    ),
+    do_parallel_foldl2_parent_loop(KeepGoing, MakeTarget, Info,
+        NumChildJobs, LaterTargets, Success0, Success, !PF, !IO).
+
+:- pred start_initial_child_jobs(bool::in,
+    foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
+    Info::in, list(T)::in, int::in, int::out,
+    PF::in, PF::out, io::di, io::uo) is det <= par_fold(PF).
+
+start_initial_child_jobs(_KeepGoing, _MakeTarget, _Info,
+        [], !NumChildJobs, !PF, !IO).
+start_initial_child_jobs(KeepGoing, MakeTarget, Info,
+        [Target | Targets], !NumChildJobs, !PF, !IO) :-
+    run_in_child(MakeTarget, Info, Target, Success, !PF, !IO),
     (
-        MaybeExcp = yes(Excp),
-        rethrow(exception(Excp) : exception_result(unit))
+        Success = yes,
+        start_initial_child_jobs(KeepGoing, MakeTarget, Info, Targets,
+            !.NumChildJobs + 1, !:NumChildJobs, !PF, !IO)
     ;
-        MaybeExcp = no
+        Success = no,
+        KeepGoing = yes,
+        start_initial_child_jobs(KeepGoing, MakeTarget, Info, Targets,
+            !NumChildJobs, !PF, !IO)
+    ;
+        Success = no,
+        KeepGoing = no
     ).
 
-:- pred parent_loop(child_exits::in, bool::in, 
+:- pred do_parallel_foldl2_parent_loop(bool::in,
     foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
-    Info::in, int::in, list(T)::in, bool::in, bool::out,
-    maybe(univ)::in, maybe(univ)::out, io::di, io::uo) is det.
+    Info::in, int::in, list(T)::in, bool::in, bool::out, PF::in, PF::out,
+    io::di, io::uo) is det <= par_fold(PF).
 
-parent_loop(ChildExits, KeepGoing, MakeTarget, Info, ChildrenRunning0, Targets,
-        !Success, !MaybeExcp, !IO) :-
+do_parallel_foldl2_parent_loop(KeepGoing, MakeTarget, Info, NumChildJobs0,
+        Targets, !Success, !PF, !IO) :-
     (
         % We are done once all running children have terminated and there are
         % no more targets to make.
-        ChildrenRunning0 = 0,
+        NumChildJobs0 = 0,
         Targets = []
     ->
         true
     ;
         % Wait for a running child to indicate that it is finished.
-        channel.take(ChildExits, Exit, !IO),
+        wait_for_child_exit(Exit, !PF, !IO),
         (
             Exit = child_succeeded,
             NewSuccess = yes
         ;
             Exit = child_failed,
             NewSuccess = no
-        ;
-            Exit = child_exception(Excp),
-            (
-                !.MaybeExcp = no,
-                !:MaybeExcp = yes(Excp)
-            ;
-                !.MaybeExcp = yes(_)
-            ),
-            NewSuccess = no
         ),
         (
             ( NewSuccess = yes
@@ -458,27 +498,154 @@
             (
                 Targets = [],
                 MoreTargets = [],
-                ChildrenRunning = ChildrenRunning0 - 1
+                NumChildJobs = NumChildJobs0 - 1
             ;
                 Targets = [NextTarget | MoreTargets],
-                run_in_child(ChildExits, MakeTarget, Info, NextTarget, !IO),
-                ChildrenRunning = ChildrenRunning0
+                run_in_child(MakeTarget, Info, NextTarget, ChildStarted,
+                    !PF, !IO),
+                (
+                    ChildStarted = yes,
+                    NumChildJobs = NumChildJobs0
+                ;
+                    ChildStarted = no,
+                    NumChildJobs = NumChildJobs0 - 1,
+                    !:Success = no
+                )
             ),
-            parent_loop(ChildExits, KeepGoing, MakeTarget, Info,
-                ChildrenRunning, MoreTargets, !Success, !MaybeExcp, !IO)
+            do_parallel_foldl2_parent_loop(KeepGoing, MakeTarget, Info,
+                NumChildJobs, MoreTargets, !Success, !PF, !IO)
         ;
             % Wait for the other running children to terminate before
             % returning.
             !:Success = no,
-            wait_for_running_children(ChildExits, ChildrenRunning0 - 1, !IO)
+            wait_for_child_exits(NumChildJobs0 - 1, !PF, !IO)
         )
     ).
 
-:- pred run_in_child(child_exits::in,
+:- pred wait_for_child_exits(int::in,
+    PF::in, PF::out, io::di, io::uo) is det <= par_fold(PF).
+
+wait_for_child_exits(Num, !PF, !IO) :-
+    ( Num > 0 ->
+        wait_for_child_exit(_, !PF, !IO),
+        wait_for_child_exits(Num - 1, !PF, !IO)
+    ;
+        true
+    ).
+
+%-----------------------------------------------------------------------------%
+%
+% Parallel fold using processes
+%
+
+:- type fork_par_fold
+    --->    fork_par_fold(
+                fpf_children :: set(pid)
+            ).
+
+:- instance par_fold(fork_par_fold) where [
+    pred(run_in_child/8) is run_in_child_process,
+    pred(wait_for_child_exit/5) is wait_for_child_process_exit
+].
+
+:- pred foldl2_maybe_stop_at_error_parallel_processes(bool::in, int::in,
+    foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
+    list(T)::in, bool::out, Info::in, io::di, io::uo) is det.
+
+foldl2_maybe_stop_at_error_parallel_processes(KeepGoing, Jobs, MakeTarget,
+        Targets, Success, Info, !IO) :-
+    PF0 = fork_par_fold(set.init),
+    do_parallel_foldl2(KeepGoing, Jobs, MakeTarget, Info, Targets,
+        Success, PF0, _PF, !IO).
+
+:- pred run_in_child_process(
+    foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
+    Info::in, T::in, bool::out, fork_par_fold::in, fork_par_fold::out,
+    io::di, io::uo) is det.
+
+run_in_child_process(P, Info, T, ChildStarted, PF0, PF, !IO) :-
+    start_in_forked_process(
+        (pred(Success::out, !.IO::di, !:IO::uo) is det :-
+            P(T, Success, Info, _Info, !IO)
+        ), MaybePid, !IO),
+    (
+        MaybePid = yes(Pid),
+        ChildStarted = yes,
+        PF0 = fork_par_fold(Set0),
+        set.insert(Set0, Pid, Set),
+        PF = fork_par_fold(Set)
+    ;
+        MaybePid = no,
+        ChildStarted = no,
+        PF = PF0
+    ).
+
+:- pred wait_for_child_process_exit(child_exit::out(child_succeeded_or_failed),
+    fork_par_fold::in, fork_par_fold::out, io::di, io::uo) is det.
+
+wait_for_child_process_exit(ChildExit, PF0, PF, !IO) :-
+    wait_any(DeadPid, ChildStatus, !IO),
+    fork_par_fold(Pids0) = PF0,
+    ( set.remove(Pids0, DeadPid, Pids) ->
+        ( ChildStatus = ok(exited(0)) ->
+            ChildExit = child_succeeded
+        ;
+            ChildExit = child_failed
+        ),
+        PF = fork_par_fold(Pids)
+    ;
+        % Not a child of ours, maybe a grand child.  Ignore it.
+        wait_for_child_process_exit(ChildExit, PF0, PF, !IO)
+    ).
+
+%-----------------------------------------------------------------------------%
+%
+% Parallel fold using threads
+%
+
+:- type thread_par_fold
+    --->    thread_par_fold(
+                tpf_channel     :: channel(child_exit),
+                                % A channel to communicate between the children
+                                % and the parent.
+
+                tpf_maybe_excp  :: maybe(univ)
+                                % Remember the first of any exceptions thrown
+                                % by child threads.
+            ).
+
+:- instance par_fold(thread_par_fold) where [
+    pred(run_in_child/8) is run_in_child_thread,
+    pred(wait_for_child_exit/5) is wait_for_child_thread_exit
+].
+
+:- pred foldl2_maybe_stop_at_error_parallel_threads(bool::in, int::in,
     foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
-    Info::in, T::in, io::di, io::uo) is det.
+    list(T)::in, bool::out, Info::in, io::di, io::uo) is det.
+
+foldl2_maybe_stop_at_error_parallel_threads(KeepGoing, Jobs, MakeTarget,
+        Targets, Success, Info, !IO) :-
+    channel.init(Channel, !IO),
+    PF0 = thread_par_fold(Channel, no),
+    do_parallel_foldl2(KeepGoing, Jobs, MakeTarget, Info, Targets, Success,
+        PF0, PF, !IO),
+    %
+    % Rethrow the first of any exceptions which terminated a child thread.
+    %
+    MaybeExcp = PF ^ tpf_maybe_excp,
+    (
+        MaybeExcp = yes(Excp),
+        rethrow(exception(Excp) : exception_result(unit))
+    ;
+        MaybeExcp = no
+    ).
+
+:- pred run_in_child_thread(
+    foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
+    Info::in, T::in, bool::out, thread_par_fold::in, thread_par_fold::out,
+    io::di, io::uo) is det.
 
-run_in_child(ChildExits, P, Info, T, !IO) :-
+run_in_child_thread(P, Info, T, ChildStarted, PF, PF, !IO) :-
     promise_equivalent_solutions [!:IO] (
         spawn((pred(!.IO::di, !:IO::uo) is cc_multi :-
             try_io((pred(Succ::out, !.IO::di, !:IO::uo) is det :-
@@ -494,22 +661,35 @@
                 Result = exception(Excp),
                 Exit = child_exception(Excp)
             ),
-            channel.put(ChildExits, Exit, !IO)
+            channel.put(PF ^ tpf_channel, Exit, !IO)
         ), !IO)
-    ).
+    ),
+    ChildStarted = yes.
 
-:- pred wait_for_running_children(child_exits::in, int::in, io::di, io::uo)
-    is det.
+:- pred wait_for_child_thread_exit(child_exit::out(child_succeeded_or_failed),
+    thread_par_fold::in, thread_par_fold::out, 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)
+wait_for_child_thread_exit(ChildExit, !PF, !IO) :-
+    channel.take(!.PF ^ tpf_channel, ChildExit0, !IO),
+    (
+        ( ChildExit0 = child_succeeded
+        ; ChildExit0 = child_failed
+        ),
+        ChildExit = ChildExit0
     ;
-        true
+        ChildExit0 = child_exception(Excp),
+        ChildExit = child_failed,
+        MaybeExcp0 = !.PF ^ tpf_maybe_excp,
+        (
+            MaybeExcp0 = no,
+            !PF ^ tpf_maybe_excp := yes(Excp)
+        ;
+            MaybeExcp0 = yes(_)
+        )
     ).
 
 %-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 
 build_with_module_options_and_output_redirect(ModuleName, ExtraOptions,
         Build, Succeeded, !Info, !IO) :-
Index: compiler/process_util.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/process_util.m,v
retrieving revision 1.25
diff -u -r1.25 process_util.m
--- compiler/process_util.m	14 Jun 2007 02:24:40 -0000	1.25
+++ compiler/process_util.m	16 Aug 2007 04:43:51 -0000
@@ -19,6 +19,7 @@
 
 :- import_module bool.
 :- import_module io.
+:- import_module maybe.
 
 %-----------------------------------------------------------------------------%
 
@@ -55,6 +56,8 @@
 :- type io_pred == pred(bool, io, io).
 :- inst io_pred == (pred(out, di, uo) is det).
 
+:- type pid == int.
+
     % Does fork() work on the current platform.
     %
 :- pred can_fork is semidet.
@@ -80,6 +83,26 @@
 :- pred call_in_forked_process(io_pred::in(io_pred), bool::out,
     io::di, io::uo) is det.
 
+    % start_in_forked_process(P, Succeeded, !IO)
+    %
+    % Start executing `P' in a child process.  Returns immediately, i.e. does
+    % not wait for `P' to finish.  This predicate should only be called if
+    % fork() is available.
+    %
+    % The child process's exit code will be 0 if `P' returns a success value of
+    % `yes', or 1 if the success value is `no'.
+    %
+:- pred start_in_forked_process(io_pred::in(io_pred), maybe(pid)::out,
+    io::di, io::uo) is det.
+
+    % wait_any(Pid, ExitCode, !IO)
+    %
+    % Block until a child process has exited. Return the process ID
+    % of the child and its exit code.
+    %
+:- pred wait_any(pid::out, io.res(io.system_result)::out, io::di, io::uo)
+    is det.
+
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
@@ -275,12 +298,15 @@
 
 call_in_forked_process_with_backup(P, AltP, Success, !IO) :-
     ( can_fork ->
-        do_call_in_forked_process(P, ForkStatus, CallStatus, !IO),
-        ( ForkStatus = 1 ->
-            Success = no
-        ;
+        start_in_forked_process(P, MaybePid, !IO),
+        (
+            MaybePid = yes(Pid),
+            do_wait(Pid, _, CallStatus, !IO),
             Status = io.handle_system_command_exit_status(CallStatus),
             Success = (Status = ok(exited(0)) -> yes ; no)
+        ;
+            MaybePid = no,
+            Success = no
         )
     ;
         AltP(Success, !IO)
@@ -308,34 +334,72 @@
 #endif
 ").
 
-:- pred do_call_in_forked_process(io_pred::in(io_pred), int::out, int::out,
+start_in_forked_process(P, MaybePid, !IO) :-
+    start_in_forked_process_2(P, Pid, !IO),
+    ( Pid = 0 ->
+        MaybePid = no
+    ;
+        MaybePid = yes(Pid)
+    ).
+
+:- pred start_in_forked_process_2(io_pred::in(io_pred), pid::out,
     io::di, io::uo) is det.
 
-do_call_in_forked_process(_::in(io_pred), _::out, _::out, _::di, _::uo) :-
-    unexpected(this_file, "do_call_in_forked_process").
+start_in_forked_process_2(_, _, !IO) :-
+    sorry(this_file, "start_in_forked_process_2").
 
 :- pragma foreign_proc("C",
-    do_call_in_forked_process(Pred::in(io_pred), ForkStatus::out, Status::out,
+    start_in_forked_process_2(Pred::in(io_pred), Pid::out,
         IO0::di, IO::uo),
     [may_call_mercury, promise_pure, tabled_for_io],
-"{
+"
 #ifdef MC_CAN_FORK
-    pid_t   child_pid;
 
     IO = IO0;
-    ForkStatus = 0;
-    Status = 0;
 
-    child_pid = fork();
-    if (child_pid == -1) {                  /* error */
+    Pid = fork();
+    if (Pid == -1) {                        /* error */
         MR_perror(""error in fork()"");
-        ForkStatus = 1;
-    } else if (child_pid == 0) {            /* child */
+    } else if (Pid == 0) {                  /* child */
         MR_Integer exit_status;
 
         MC_call_child_process_io_pred(Pred, &exit_status);
         exit(exit_status);
     } else {                                /* parent */
+    }
+
+#else /* ! MC_CAN_FORK */
+    IO = IO0;
+    Pid = 0;
+#endif /* ! MC_CAN_FORK */
+").
+    % call_child_process_io_pred(P, ExitStatus).
+    %
+:- pred call_child_process_io_pred(io_pred::in(io_pred), int::out,
+    io::di, io::uo) is det.
+
+:- pragma foreign_export("C",
+    call_child_process_io_pred(in(io_pred), out, di, uo),
+    "MC_call_child_process_io_pred").
+
+call_child_process_io_pred(P, Status, !IO) :-
+    setup_child_signal_handlers(!IO),
+    P(Success, !IO),
+    Status = ( Success = yes -> 0 ; 1 ).
+
+    % do_wait(Pid, WaitedPid, Status, !IO)
+    %
+    % Wait until Pid exits and return its status.
+    % If Pid is -1 then wait for any child process to exit.
+    %
+:- pred do_wait(pid::in, pid::out, int::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    do_wait(Pid::in, WaitedPid::out, Status::out, IO0::di, IO::uo),
+    [will_not_call_mercury, promise_pure, tabled_for_io],
+"
+#ifdef MC_CAN_FORK
+    {
         int     child_status;
         pid_t   wait_status;
 
@@ -354,7 +418,8 @@
 
         while (1) {
             wait_status = wait(&child_status);
-            if (wait_status == child_pid) {
+            if (Pid == -1 || wait_status == Pid) {
+                WaitedPid = wait_status;
                 Status = child_status;
                 break;
             } else if (wait_status == -1) {
@@ -368,7 +433,9 @@
                         ** to system() which would cause SIGINT
                         ** to be ignored on some systems (e.g. Linux).
                         */
-                        kill(child_pid, SIGTERM);
+                        if (Pid != -1) {
+                            kill(Pid, SIGTERM);
+                        }
                         break;
                     }
                 } else {
@@ -376,7 +443,6 @@
                     ** This should never happen.
                     */
                     MR_perror(""error in wait(): "");
-                    ForkStatus = 1;
                     Status = 1;
                     break;
                 }
@@ -394,28 +460,18 @@
 #ifdef SIGQUIT
         MR_signal_should_restart(SIGQUIT, MR_TRUE);
 #endif
-
     }
+
 #else /* ! MC_CAN_FORK */
+    MR_perror(""cannot wait() when fork() is unavailable: "");
     IO = IO0;
-    ForkStatus = 1;
     Status = 1;
 #endif /* ! MC_CAN_FORK */
-}").
-
-    % call_child_process_io_pred(P, ExitStatus).
-    %
-:- pred call_child_process_io_pred(io_pred::in(io_pred), int::out,
-    io::di, io::uo) is det.
-
-:- pragma foreign_export("C",
-    call_child_process_io_pred(in(io_pred), out, di, uo),
-    "MC_call_child_process_io_pred").
+").
 
-call_child_process_io_pred(P, Status, !IO) :-
-    setup_child_signal_handlers(!IO),
-    P(Success, !IO),
-    Status = ( Success = yes -> 0 ; 1 ).
+wait_any(Pid, Status, !IO) :-
+    do_wait(-1, Pid, Status0, !IO),
+    Status = io.handle_system_command_exit_status(Status0).
 
 %-----------------------------------------------------------------------------%
 
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------



More information about the reviews mailing list