[m-rev.] for review: prevent interleaved errors with mmc --make

Peter Wang novalazy at gmail.com
Wed May 9 12:23:06 AEST 2012


Branches: main

Prevent interleaved error message output when using parallel `mmc --make'.

compiler/make.m:
	Add a field to `make_info' to hold an inter-process lock.

compiler/make.util.m:
	Reuse the `job_ctl' type as the stdout lock.  Add predicates to acquire
	and release the lock.

	Make `foldl2_maybe_stop_at_error_parallel_processes' set the stdout
	lock in `make_info' for child processes to see.

	Acquire and release the stdout lock in various predicates that write
	errors messages.

compiler/make.module_target.m:
compiler/make.program_target.m:
	Conform to changes.

diff --git a/compiler/make.m b/compiler/make.m
index f377619..6fa5008 100644
--- a/compiler/make.m
+++ b/compiler/make.m
@@ -165,7 +165,11 @@
                 % `--analysis-repeat' and decrements to zero as analysis passes
                 % on `suboptimal' modules are performed. `invalid' modules
                 % are not affected as they will always be reanalysed.
-                reanalysis_passes       :: int
+                reanalysis_passes       :: int,
+
+                % An inter-process lock to prevent multiple processes
+                % interleaving their output to standard output.
+                maybe_stdout_lock       :: maybe(stdout_lock)
             ).
 
 :- type module_index_map
@@ -363,7 +367,7 @@ make_process_args(Globals, Variables, OptionArgs, Targets0, !IO) :-
             init_cached_foreign_imports,
             ShouldRebuildModuleDeps, KeepGoing,
             set.init, no, set.list_to_set(ClassifiedTargets),
-            AnalysisRepeat),
+            AnalysisRepeat, no),
 
         % Build the targets, stopping on any errors if `--keep-going'
         % was not set.
diff --git a/compiler/make.module_target.m b/compiler/make.module_target.m
index 11ef26b..aebe927 100644
--- a/compiler/make.module_target.m
+++ b/compiler/make.module_target.m
@@ -758,7 +758,7 @@ record_made_target_2(Globals, Succeeded, TargetFile, TouchedTargetFiles,
     ;
         Succeeded = no,
         TargetStatus = deps_status_error,
-        target_file_error(Globals, TargetFile, !IO)
+        target_file_error(!.Info, Globals, TargetFile, !IO)
     ),
 
     list.foldl(update_target_status(TargetStatus), TouchedTargetFiles, !Info),
diff --git a/compiler/make.program_target.m b/compiler/make.program_target.m
index 5709442..84c18c8 100644
--- a/compiler/make.program_target.m
+++ b/compiler/make.program_target.m
@@ -552,7 +552,7 @@ build_linked_target_2(Globals, MainModuleName, FileType, OutputFileName,
     ),
     (
         DepsResult = deps_error,
-        file_error(OutputFileName, !IO),
+        file_error(!.Info, OutputFileName, !IO),
         Succeeded = no
     ;
         DepsResult = deps_up_to_date,
@@ -668,7 +668,7 @@ build_linked_target_2(Globals, MainModuleName, FileType, OutputFileName,
                 map.delete(!.Info ^ file_timestamps, OutputFileName)
         ;
             Succeeded = no,
-            file_error(OutputFileName, !IO)
+            file_error(!.Info, OutputFileName, !IO)
         )
     ).
 
diff --git a/compiler/make.util.m b/compiler/make.util.m
index 5667c5c..5e1ac48 100644
--- a/compiler/make.util.m
+++ b/compiler/make.util.m
@@ -240,6 +240,8 @@
 % Debugging, verbose and error messages
 %
 
+:- type stdout_lock.
+
     % Apply the given predicate if `--debug-make' is set.
     % XXX Do we need this, now that we have trace goals?
     %
@@ -295,11 +297,12 @@
 
     % Write a message "** Error making <filename>".
     %
-:- pred target_file_error(globals::in, target_file::in, io::di, io::uo) is det.
+:- pred target_file_error(make_info::in, globals::in, target_file::in,
+    io::di, io::uo) is det.
 
     % Write a message "** Error making <filename>".
     %
-:- pred file_error(file_name::in, io::di, io::uo) is det.
+:- pred file_error(make_info::in, file_name::in, io::di, io::uo) is det.
 
     % If the given target was specified on the command line, warn that it
     % was already up to date.
@@ -440,9 +443,9 @@ foldl2_maybe_stop_at_error_maybe_parallel(KeepGoing, MakeTarget, Globals,
             Targets, Success, !Info, !IO)
     ).
 
-:- pred foldl2_maybe_stop_at_error_parallel_processes(bool::in,
-    int::in, foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
-    globals::in, list(T)::in, bool::out, Info::in, Info::out,
+:- pred foldl2_maybe_stop_at_error_parallel_processes(bool::in, int::in,
+    foldl2_pred_with_status(T, make_info, io)::in(foldl2_pred_with_status),
+    globals::in, list(T)::in, bool::out, make_info::in, make_info::out,
     io::di, io::uo) is det.
 
 foldl2_maybe_stop_at_error_parallel_processes(KeepGoing, Jobs, MakeTarget,
@@ -451,6 +454,7 @@ foldl2_maybe_stop_at_error_parallel_processes(KeepGoing, Jobs, MakeTarget,
     create_job_ctl(TotalTasks, MaybeJobCtl, !IO),
     (
         MaybeJobCtl = yes(JobCtl),
+        !Info ^ maybe_stdout_lock := yes(JobCtl),
         list.foldl2(
             start_worker_process(Globals, KeepGoing, MakeTarget, Targets,
                 JobCtl, !.Info),
@@ -460,6 +464,7 @@ foldl2_maybe_stop_at_error_parallel_processes(KeepGoing, Jobs, MakeTarget,
             worker_loop(Globals, KeepGoing, MakeTarget, Targets, JobCtl, yes),
             worker_loop_signal_cleanup(JobCtl, Pids), Success0, !Info, !IO),
         list.foldl2(reap_worker_process, Pids, Success0, Success, !IO),
+        !Info ^ maybe_stdout_lock := no,
         destroy_job_ctl(JobCtl, !IO)
     ;
         MaybeJobCtl = no,
@@ -896,6 +901,54 @@ make_yes_job_ctl(JobCtl) = yes(JobCtl).
 make_no_job_ctl = no.
 
 %-----------------------------------------------------------------------------%
+%
+% Prevent interleaved error output
+%
+
+    % We can reuse the job_ctl type.
+    %
+:- type stdout_lock == job_ctl.
+
+:- pred lock_stdout(stdout_lock::in, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    lock_stdout(JobCtl::in, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
+        may_not_duplicate],
+"
+#ifdef MC_HAVE_JOBCTL_IPC
+    MC_lock_job_ctl(JobCtl);
+#endif
+").
+
+:- pred unlock_stdout(stdout_lock::in, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    unlock_stdout(JobCtl::in, _IO0::di, _IO::uo),
+    [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
+        may_not_duplicate],
+"
+#ifdef MC_HAVE_JOBCTL_IPC
+    MC_unlock_job_ctl(JobCtl);
+#endif
+").
+
+:- pred with_locked_stdout(make_info::in,
+    pred(io, io)::in(pred(di, uo) is det), io::di, io::uo) is det.
+
+with_locked_stdout(Info, Pred, !IO) :-
+    MaybeLock = Info ^ maybe_stdout_lock,
+    (
+        MaybeLock = yes(Lock),
+        lock_stdout(Lock, !IO),
+        Pred(!IO),
+        unlock_stdout(Lock, !IO)
+    ;
+        MaybeLock = no,
+        Pred(!IO)
+    ).
+
+%-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
 
 build_with_module_options_and_output_redirect(Globals, ModuleName,
@@ -1014,12 +1067,8 @@ redirect_output(_ModuleName, MaybeErrorStream, !Info, !IO) :-
     ;
         ErrorFileRes = error(IOError),
         MaybeErrorStream = no,
-        io.write_string("** Error opening `", !IO),
-        io.write_string(ErrorFileName, !IO),
-        io.write_string("' for output: ", !IO),
-        io.error_message(IOError, Msg),
-        io.write_string(Msg, !IO),
-        io.nl(!IO)
+        with_locked_stdout(!.Info,
+            write_error_opening_output(ErrorFileName, IOError), !IO)
     ).
 
 unredirect_output(Globals, ModuleName, ErrorOutputStream, !Info, !IO) :-
@@ -1041,44 +1090,44 @@ unredirect_output(Globals, ModuleName, ErrorOutputStream, !Info, !IO) :-
             globals.lookup_int_option(Globals, output_compile_error_lines,
                 LinesToWrite),
             io.output_stream(CurrentOutputStream, !IO),
-            io.input_stream_foldl2_io(TmpErrorInputStream,
-                make_write_error_char(ErrorFileOutputStream,
-                    CurrentOutputStream),
-                LinesToWrite, TmpFileInputRes, !IO),
-            (
-                TmpFileInputRes = ok(_)
-            ;
-                TmpFileInputRes = error(_, TmpFileInputError),
-                io.write_string("Error reading `", !IO),
-                io.write_string(TmpErrorFileName, !IO),
-                io.write_string("': ", !IO),
-                io.write_string(io.error_message(TmpFileInputError), !IO),
-                io.nl(!IO)
-            ),
-
+            with_locked_stdout(!.Info,
+                make_write_error_streams(TmpErrorFileName, TmpErrorInputStream,
+                    ErrorFileOutputStream, CurrentOutputStream, LinesToWrite),
+                    !IO),
             io.close_output(ErrorFileOutputStream, !IO),
 
             !Info ^ error_file_modules :=
                 set.insert(!.Info ^ error_file_modules, ModuleName)
         ;
             ErrorFileRes = error(Error),
-            io.write_string("Error opening `", !IO),
-            io.write_string(TmpErrorFileName, !IO),
-            io.write_string("': ", !IO),
-            io.write_string(io.error_message(Error), !IO),
-            io.nl(!IO)
+            with_locked_stdout(!.Info,
+                write_error_opening_file(TmpErrorFileName, Error), !IO)
         ),
         io.close_input(TmpErrorInputStream, !IO)
     ;
         TmpErrorInputRes = error(Error),
-        io.write_string("Error opening `", !IO),
-        io.write_string(TmpErrorFileName, !IO),
-        io.write_string("': ", !IO),
-        io.write_string(io.error_message(Error), !IO),
-        io.nl(!IO)
+        with_locked_stdout(!.Info,
+            write_error_opening_file(TmpErrorFileName, Error), !IO)
     ),
     io.remove_file(TmpErrorFileName, _, !IO).
 
+:- pred make_write_error_streams(string::in, io.input_stream::in,
+    io.output_stream::in, io.output_stream::in, int::in, io::di, io::uo)
+    is det.
+
+make_write_error_streams(FileName, InputStream, FullOutputStream,
+        PartialOutputStream, LinesToWrite, !IO) :-
+    io.input_stream_foldl2_io(InputStream,
+        make_write_error_char(FullOutputStream, PartialOutputStream),
+        LinesToWrite, Res, !IO),
+    (
+        Res = ok(_)
+    ;
+        Res = error(_, Error),
+        io.format("Error reading `%s': %s\n",
+            [s(FileName), s(io.error_message(Error))], !IO)
+    ).
+
 :- pred make_write_error_char(io.output_stream::in, io.output_stream::in,
     char::in, int::in, int::out, io::di, io::uo) is det.
 
@@ -1104,6 +1153,20 @@ make_write_error_char(FullOutputStream, PartialOutputStream, Char,
         true
     ).
 
+:- pred write_error_opening_output(string::in, io.error::in,
+    io::di, io::uo) is det.
+
+write_error_opening_output(FileName, Error, !IO) :-
+    io.format("** Error opening `%s' for output: %s\n",
+        [s(FileName), s(io.error_message(Error))], !IO).
+
+:- pred write_error_opening_file(string::in, io.error::in, io::di, io::uo)
+    is det.
+
+write_error_opening_file(FileName, Error, !IO) :-
+    io.format("Error opening `%s': %s\n",
+        [s(FileName), s(io.error_message(Error))], !IO).
+
 %-----------------------------------------------------------------------------%
 
 get_timestamp_file_timestamp(Globals, target_file(ModuleName, FileType),
@@ -1761,14 +1824,14 @@ maybe_reanalyse_modules_message(Globals, !IO) :-
                 "Reanalysing invalid/suboptimal modules\n", !IO)
         ), !IO).
 
-target_file_error(Globals, TargetFile, !IO) :-
-    make_write_target_file_wrapped(Globals,
-        "** Error making `", TargetFile, "'.\n", !IO).
+target_file_error(Info, Globals, TargetFile, !IO) :-
+    with_locked_stdout(Info,
+        make_write_target_file_wrapped(Globals,
+            "** Error making `", TargetFile, "'.\n"), !IO).
 
-file_error(TargetFile, !IO) :-
-    % Try to write this with one call to avoid interleaved output when doing
-    % parallel builds.
-    io.write_string("** Error making `" ++ TargetFile ++ "'.\n", !IO).
+file_error(Info, TargetFile, !IO) :-
+    with_locked_stdout(Info,
+        io.write_string("** Error making `" ++ TargetFile ++ "'.\n"), !IO).
 
 maybe_warn_up_to_date_target(Globals, Target, !Info, !IO) :-
     globals.lookup_bool_option(Globals, warn_up_to_date, Warn),

--------------------------------------------------------------------------
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