[m-rev.] for review: parallel mmc make
Julien Fischer
juliensf at csse.unimelb.edu.au
Fri Feb 9 17:48:05 AEDT 2007
On Fri, 9 Feb 2007, Peter Wang wrote:
> Branches: main
>
> Add initial support for parallel make functionality in `mmc --make', using
> Mercury threads (not processes).
How much work will be required to extend it to use processes instead
of threads?
Do you have any performance figures for this change yet?
asm_fast.gc vs. asm_fast.par.gc with one job vs. asm_fast.par.gc with
multiple jobs.
Does bootchecking with parallel --make work?
> Currently this is limited to running the
> "compile target code to object code" step in parallel.
I take it that this because of the way mmc --make currently computes
its task list? (I think we discussed this at once?)
> configure.in:
> Require that the bootstrap compiler support the `thread_local'
> attribute on mutables.
>
> compiler/globals.m:
> Use a thread-local mutable to hold the compiler's globals instead of
> the globals facility in the io module.
>
> Make the `extra_error_info' mutable thread-local.
>
> compiler/options.m:
> doc/user_guide.texi:
> Add a `--parallel-jobs <n>' option.
> compiler/make.util.m:
> Add a `foldl2_maybe_stop_at_error_maybe_parallel' predicate which is
> like `foldl2_maybe_stop_at_error' but capable of running tasks in
> parallel depending on the `--parallel-jobs' option.
>
> compiler/make.program_target.m:
> Use `foldl2_maybe_stop_at_error_maybe_parallel' for the "target code to
> object code" step.
>
> library/io.m:
> Make the current input/output streams thread-local in C grades. This
> uses the same underlying mechanisms as thread-local mutables. Direct
> references to the current stream variables are replaced by calls to
> functions which work with the thread-local current streams instead.
>
> Add a mutex and locking predicates to protect the stream_db structure.
> Mark `get_stream_db' and `set_stream_db' as thread-safe and protect
> calls to those predicates with the locking predicates.
>
> Rename the impure version of `get_stream_db' to
> `get_stream_db_with_locking' and make it acquire and release the
> stream_db mutex.
>
> Add a mutex to protect the `ML_next_stream_id' counter.
>
> Add a note about a thread-safety problem in `io.get_system_error'.
>
> Mark `io.call_system_code' as `thread_safe'.
>
> library/list.m:
> Add the predicate `list.split_upto', which is to `list.split_list' as
> `list.take_upto' is to `list.take'.
>
> library/stream.string_writer.m:
> Conform to the renaming of the impure `io.get_stream_db'.
>
> library/thread.m:
> Add a predicate `can_spawn', which succeeds if `spawn' is supported in
> the current grade.
>
> NEWS:
> Announce parallel make support.
>
> Announce `list.split_upto'.
and announce `can_spawn/0'.
> Index: NEWS
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/NEWS,v
> retrieving revision 1.442
> diff -u -r1.442 NEWS
> --- NEWS 5 Feb 2007 03:12:50 -0000 1.442
> +++ NEWS 7 Feb 2007 02:04:42 -0000
> @@ -80,6 +81,9 @@
> * The compiler now issues a warning when an inst declaration is not
> consistent with any of the types in scope.
>
> +* We have added some initial support for simultaneous execution of jobs in
> + `mmc --make'.
> +
> Changes to the Mercury deep profiler:
>
> * The deep profiler now supports measuring a proxy for time: a counter that
> @@ -156,6 +160,9 @@
> This makes it easier to diagnose mode errors caused by insts that are not
> consistent with the type they are intended to be consistent with.
>
> +* Simultaneous execution of jobs with `mmc --make' can be enabled with
> + the `--parallel-jobs <n>' option.
> +
> Changes to the Mercury standard library:
>
> * The predicates io.seek_binary/5 and io.binary_stream_offset/4 have been
> Index: compiler/globals.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
> retrieving revision 1.79
> diff -u -r1.79 globals.m
> --- compiler/globals.m 8 Jan 2007 03:03:09 -0000 1.79
> +++ compiler/globals.m 16 Jan 2007 23:48:55 -0000
> @@ -362,11 +362,14 @@
> may_be_thread_safe :: bool
> ).
>
> +:- mutable(globals, univ, univ(0), ground,
> + [untrailed, attach_to_io_state, thread_local]).
> +
> % Is there extra information about errors available that could be printed
> % out if `-E' were enabled.
> %
> :- mutable(extra_error_info, bool, no, ground,
> - [untrailed, attach_to_io_state]).
> + [untrailed, attach_to_io_state, thread_local]).
>
> globals_init(Options, Target, GC_Method, TagsMethod,
> TerminationNorm, Termination2Norm, TraceLevel, TraceSuppress,
> @@ -569,7 +572,7 @@
> get_extra_error_info(ExtraErrorInfo, !IO).
>
> io_get_globals(Globals, !IO) :-
> - io.get_globals(UnivGlobals, !IO),
> + globals.get_globals(UnivGlobals, !IO),
> ( univ_to_type(UnivGlobals, Globals0) ->
> Globals = Globals0
> ;
> @@ -578,7 +581,7 @@
>
> io_set_globals(Globals, !IO) :-
> type_to_univ(Globals, UnivGlobals),
> - io.set_globals(UnivGlobals, !IO).
> + globals.set_globals(UnivGlobals, !IO).
>
Can some of the unsafe_promise_uniques in this module now be deleted?
...
> Index: compiler/make.program_target.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/make.program_target.m,v
> retrieving revision 1.65
> diff -u -r1.65 make.program_target.m
> --- compiler/make.program_target.m 8 Jan 2007 03:03:10 -0000 1.65
> +++ compiler/make.program_target.m 22 Jan 2007 04:42:19 -0000
> @@ -156,10 +156,26 @@
> ObjModules, ForeignObjTargetsList, !Info, !IO),
> ForeignObjTargets = list.condense(ForeignObjTargetsList),
>
> - foldl2_maybe_stop_at_error(KeepGoing,
> - foldl2_maybe_stop_at_error(KeepGoing, make_module_target),
> - [IntermediateTargets, ObjTargets, ForeignObjTargets],
> - BuildDepsSucceeded, !Info, !IO),
> + foldl2_maybe_stop_at_error(KeepGoing, make_module_target,
> + IntermediateTargets, BuildDepsSucceeded0, !Info, !IO),
> + (
> + BuildDepsSucceeded0 = yes,
> + foldl2_maybe_stop_at_error_maybe_parallel(KeepGoing,
> + make_module_target, ObjTargets,
> + BuildDepsSucceeded1, !Info, !IO)
> + ;
> + BuildDepsSucceeded0 = no,
> + BuildDepsSucceeded1 = no
> + ),
> + (
> + BuildDepsSucceeded1 = yes,
> + foldl2_maybe_stop_at_error(KeepGoing, make_module_target,
> + ForeignObjTargets,
> + BuildDepsSucceeded, !Info, !IO)
> + ;
> + BuildDepsSucceeded1 = no,
> + BuildDepsSucceeded = no
> + ),
>
> linked_target_file_name(MainModuleName, FileType, OutputFileName, !IO),
> get_file_timestamp([dir.this_directory], OutputFileName,
> Index: compiler/make.util.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/make.util.m,v
> retrieving revision 1.41
> diff -u -r1.41 make.util.m
> --- compiler/make.util.m 1 Dec 2006 15:04:05 -0000 1.41
> +++ compiler/make.util.m 7 Feb 2007 01:20:47 -0000
> @@ -53,6 +53,22 @@
>
> %-----------------------------------------------------------------------------%
>
> + % foldl2_maybe_stop_at_error_maybe_parallel(KeepGoing, P, List, Succeeded,
> + % !Info, !IO).
> + %
> + % 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)
> + % concurrently, in any order, and multiple times.
> + %
> +:- pred foldl2_maybe_stop_at_error_maybe_parallel(bool::in,
> + foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
> + list(T)::in, bool::out, Info::in, Info::out, io::di, io::uo) is det.
> +
> +%-----------------------------------------------------------------------------%
> +
> :- type build(T, Info1, Info2) == pred(T, bool, Info1, Info2, io, io).
> :- type build(T, Info) == build(T, Info, Info).
> :- type build(T) == build(T, make_info).
> @@ -280,6 +296,11 @@
>
> :- import_module char.
> :- import_module dir.
> +:- import_module exception.
> +:- import_module thread.
> +:- import_module thread.channel.
> +
> +:- type child_exits == channel(bool).
See below. I think this should encode when child exits with an
exception as well.
...
> +foldl2_maybe_stop_at_error_maybe_parallel(KeepGoing, MakeTarget, Targets,
> + Success, !Info, !IO) :-
> + globals.io_lookup_int_option(parallel_jobs, ParallelJobs, !IO),
> + (
> + thread.can_spawn,
> + ParallelJobs > 1
> + ->
> + foldl2_maybe_stop_at_error_parallel(KeepGoing, ParallelJobs,
> + MakeTarget, Targets, Success0, !.Info, !IO)
> + ;
> + Success0 = yes
> + ),
> + (
> + Success0 = yes,
> + foldl2_maybe_stop_at_error(KeepGoing, MakeTarget, Targets, Success,
> + !Info, !IO)
> + ;
> + Success0 = no,
> + Success = no
> + ).
> +
> +:- pred foldl2_maybe_stop_at_error_parallel(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(KeepGoing, ParallelJobs,
> + MakeTarget, Targets, Success, Info, !IO) :-
> + channel.init(ChildExits, !IO),
> + list.split_upto(ParallelJobs, Targets, InitialTargets, LaterTargets),
> + list.foldl(run_in_child(ChildExits, MakeTarget, Info), InitialTargets,
> + !IO),
> + parent_loop(ChildExits, KeepGoing, MakeTarget, Info,
> + length(Targets), LaterTargets, yes, Success, !IO).
> +
> +:- pred parent_loop(child_exits::in, 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, io::di, io::uo)
> + is det.
> +
> +parent_loop(ChildExits, KeepGoing, MakeTarget, Info, ChildrenLeft, Targets,
> + !Success, !IO) :-
> + ( ChildrenLeft = 0 ->
> + true
> + ;
> + % Wait for a running child to indicate that it is finished.
> + channel.take(ChildExits, NewSuccess, !IO),
> + (
> + ( NewSuccess = yes
> + ; KeepGoing = yes
> + )
> + ->
> + !:Success = !.Success `and` NewSuccess,
> + (
> + Targets = [],
> + MoreTargets = []
> + ;
> + Targets = [NextTarget | MoreTargets],
> + run_in_child(ChildExits, MakeTarget, Info, NextTarget, !IO)
> + ),
> + parent_loop(ChildExits, KeepGoing, MakeTarget, Info,
> + ChildrenLeft-1, MoreTargets, !Success, !IO)
> + ;
> + !:Success = no
> + )
> + ).
> +
> +:- pred run_in_child(child_exits::in,
> + foldl2_pred_with_status(T, Info, io)::in(foldl2_pred_with_status),
> + Info::in, T::in, io::di, io::uo) is det.
> +
> +run_in_child(ChildExits, P, Info, T, !IO) :-
> + promise_equivalent_solutions [!:IO] (
> + spawn((pred(!.IO::di, !:IO::uo) is cc_multi :-
> + %
> + % Make sure something always gets written to ChildExits when P
> + % finishes, even if terminated by an exception.
> + %
> + try_io((pred(Succ::out, !.IO::di, !:IO::uo) is det :-
> + P(T, Succ, Info, _Info, !IO)
> + ), Result, !IO),
> + (
> + Result = succeeded(Success),
> + channel.put(ChildExits, Success, !IO)
> + ;
> + Result = exception(_),
> + channel.put(ChildExits, no, !IO),
> + rethrow(Result)
Rethrowing that exception is almost certain to do something very dodgy
if the thread is not the main thread. It might be better if parent loop
were just informed that a child had terminated with an exception via
some other mechanism (the channel would be the obvious one) rather
than rethrowing the exception.
> Index: compiler/options.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
> retrieving revision 1.546
> diff -u -r1.546 options.m
> --- compiler/options.m 19 Jan 2007 07:04:25 -0000 1.546
> +++ compiler/options.m 22 Jan 2007 04:22:36 -0000
> @@ -765,6 +765,7 @@
> ; make
> ; keep_going
> ; rebuild
> + ; parallel_jobs
I suggest just naming this option as `jobs' (for consistency with
make if nothing else).
> ; invoked_by_mmc_make
> ; extra_init_command
> ; pre_link_command
> @@ -1513,6 +1514,7 @@
> make - bool(no),
> keep_going - bool(no),
> rebuild - bool(no),
> + parallel_jobs - int(1),
> invoked_by_mmc_make - bool(no),
> pre_link_command - maybe_string(no),
> extra_init_command - maybe_string(no),
> @@ -2293,6 +2295,7 @@
> long_option("make", make).
> long_option("keep-going", keep_going).
> long_option("rebuild", rebuild).
> +long_option("parallel-jobs", parallel_jobs).
I suggest adding `-j' as an alias for this.
> long_option("invoked-by-mmc-make", invoked_by_mmc_make).
> long_option("pre-link-command", pre_link_command).
> long_option("extra-init-command", extra_init_command).
> @@ -4662,6 +4665,9 @@
> "-k, --keep-going",
> "\tWith `--make', keep going as far as",
> "\tpossible even if an error is detected.",
> + "--parallel-jobs <n>",
> + "\tWith `--make', attempt to perform up to <n> jobs",
> + "\tconcurrently for some tasks.",
> "--pre-link-command <command>",
> "\tSpecify a command to run before linking with `mmc --make'.",
> "\tThis can be used to compile C source files which rely on",
> Index: doc/user_guide.texi
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/doc/user_guide.texi,v
> retrieving revision 1.509
> diff -u -r1.509 user_guide.texi
> --- doc/user_guide.texi 19 Jan 2007 07:05:04 -0000 1.509
> +++ doc/user_guide.texi 7 Feb 2007 02:58:10 -0000
> @@ -843,7 +843,6 @@
>
> The advantages of the @samp{mmc --make} over Mmake are that there
> is no @samp{mmake depend} step and the dependencies are more accurate.
> -Parallel builds are not yet supported.
>
> Note that @samp{--use-subdirs} is automatically enabled if you specify
> @samp{mmc --make}.
> @@ -8432,6 +8431,17 @@
> current directory.
> @samp{--use-grade-subdirs} does not work with Mmake (it does
> work with @samp{mmc --make}).
> +
> + at sp 1
> + at item --parallel-jobs <n>
> + at findex --parallel-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
> +the @samp{-P} option in the @samp{MERCURY_OPTIONS} environment variable
> +(see @ref{Environment}).
> +
> @end table
>
> @node Miscellaneous options
> Index: library/io.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/io.m,v
> retrieving revision 1.368
> diff -u -r1.368 io.m
> --- library/io.m 18 Jan 2007 07:33:03 -0000 1.368
> +++ library/io.m 7 Feb 2007 00:45:25 -0000
> @@ -22,6 +22,11 @@
> % Attempting any operation on a stream which has already been closed results
> % in undefined behaviour.
> %
> +% In multithreaded programs, each thread in the program has its own set of
> +% "current" input and output streams. At the time it is created, a child
> +% thread inherits the current streams from its parent. Predicates which
> +% change which stream is current affect only the calling thread.
> +%
> %-----------------------------------------------------------------------------%
> %-----------------------------------------------------------------------------%
>
> @@ -1527,7 +1532,7 @@
> % about those streams.
> %
> :- pred io.get_stream_db(io.stream_db::out, io::di, io::uo) is det.
> -:- impure pred io.get_stream_db(io.stream_db::out) is det.
> +:- impure pred io.get_stream_db_with_locking(io.stream_db::out) is det.
>
> % Returns the information associated with the specified input
> % stream in the given stream database.
> @@ -1603,29 +1608,33 @@
> extern MR_Word ML_io_stream_db;
> extern MR_Word ML_io_user_globals;
>
> - #ifdef MR_THREAD_SAFE
> - extern MercuryLock ML_io_user_globals_lock;
> - #endif
> -
> extern int ML_next_stream_id;
> #if 0
> extern MR_Word ML_io_ops_table;
> #endif
> +
> + #ifdef MR_THREAD_SAFE
> + extern MercuryLock ML_io_stream_db_lock;
> + extern MercuryLock ML_io_user_globals_lock;
> + extern MercuryLock ML_io_next_stream_id_lock;
> + #endif
> ").
>
> :- pragma foreign_code("C", "
> MR_Word ML_io_stream_db;
> MR_Word ML_io_user_globals;
>
> - #ifdef MR_THREAD_SAFE
> - MercuryLock ML_io_user_globals_lock;
> - #endif
> -
> /* a counter used to generate unique stream ids */
> int ML_next_stream_id;
> #if 0
> MR_Word ML_io_ops_table;
> #endif
> +
> + #ifdef MR_THREAD_SAFE
> + MercuryLock ML_io_stream_db_lock;
> + MercuryLock ML_io_user_globals_lock;
> + MercuryLock ML_io_next_stream_id_lock;
> + #endif
> ").
>
> :- pragma foreign_code("C#", "
> @@ -2242,6 +2251,12 @@
> [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
> does_not_affect_liveness],
> "{
> + /*
> + ** XXX If the Mercury context that called the failing C function is now
> + ** running on a different OS thread, this errno won't be the one
> + ** we are looking for. Or, if a different Mercury context was run on
> + ** the same thread in the meantime, the errno could have been clobbered.
> + */
> Error = errno;
> MR_update_io(IO0, IO);
> }").
> @@ -4211,7 +4226,9 @@
> io::di, io::uo) is det.
>
> io.stream_info(Stream, MaybeInfo, !IO) :-
> + io.lock_stream_db(!IO),
> io.get_stream_db(StreamDb, !IO),
> + io.unlock_stream_db(!IO),
> ( map.search(StreamDb, get_stream_id(Stream), Info) ->
> MaybeInfo = yes(Info)
> ;
> @@ -4276,35 +4293,67 @@
> source_name(stdout) = "<standard output>".
> source_name(stderr) = "<standard error>".
>
> + % Caller must NOT hold stream_db lock.
> + %
> :- pragma foreign_proc("C",
> - io.get_stream_db(StreamDb::out),
> - [will_not_call_mercury, tabled_for_io],
> + io.get_stream_db_with_locking(StreamDb::out),
> + [will_not_call_mercury, thread_safe, tabled_for_io],
> "
> + MR_LOCK(&ML_io_stream_db_lock, ""io.get_stream_db/1"");
> StreamDb = ML_io_stream_db;
> + MR_UNLOCK(&ML_io_stream_db_lock, ""io.get_stream_db/1"");
> ").
>
> + % Caller must hold stream_db lock.
> + %
> :- pragma foreign_proc("C",
> io.get_stream_db(StreamDb::out, IO0::di, IO::uo),
> - [will_not_call_mercury, promise_pure, tabled_for_io,
> + [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
> does_not_affect_liveness],
> "
> StreamDb = ML_io_stream_db;
> MR_update_io(IO0, IO);
> ").
>
> + % Caller must hold stream_db lock.
> + %
> :- pred io.set_stream_db(io.stream_db::in, io::di, io::uo) is det.
>
> :- pragma foreign_proc("C",
> io.set_stream_db(StreamDb::in, IO0::di, IO::uo),
> - [will_not_call_mercury, promise_pure, tabled_for_io,
> + [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io,
> does_not_affect_liveness],
> "
> ML_io_stream_db = StreamDb;
> MR_update_io(IO0, IO);
> ").
>
> +:- pred io.lock_stream_db(io::di, io::uo) is det.
> +
> +:- pragma foreign_proc("C",
> + io.lock_stream_db(IO0::di, IO::uo),
> + [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
> +"
> + MR_LOCK(&ML_io_stream_db_lock, MR_PROC_LABEL);
> + IO = IO0;
> +").
> +
> +io.lock_stream_db(!IO).
> +
> +:- pred io.unlock_stream_db(io::di, io::uo) is det.
> +
> +:- pragma foreign_proc("C",
> + io.unlock_stream_db(IO0::di, IO::uo),
> + [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
> +"
> + MR_UNLOCK(&ML_io_stream_db_lock, MR_PROC_LABEL);
> + IO = IO0;
> +").
> +
> +io.unlock_stream_db(!IO).
> +
> :- pragma foreign_proc("C#",
> - io.get_stream_db(StreamDb::out),
> + io.get_stream_db_with_locking(StreamDb::out),
> [will_not_call_mercury, tabled_for_io],
> "
> StreamDb = ML_io_stream_db;
> @@ -4325,7 +4374,7 @@
> ").
>
> :- pragma foreign_proc("Java",
> - io.get_stream_db(StreamDb::out),
> + io.get_stream_db_with_locking(StreamDb::out),
> [will_not_call_mercury, tabled_for_io],
> "
> StreamDb = ML_io_stream_db;
> @@ -4351,18 +4400,22 @@
> io::di, io::uo) is det.
>
> io.insert_stream_info(Stream, Name, !IO) :-
> + io.lock_stream_db(!IO),
> io.get_stream_db(StreamDb0, !IO),
> map.set(StreamDb0, get_stream_id(Stream), Name, StreamDb),
> - io.set_stream_db(StreamDb, !IO).
> + io.set_stream_db(StreamDb, !IO),
> + io.unlock_stream_db(!IO).
>
> :- pred io.maybe_delete_stream_info(io.stream::in, io::di, io::uo) is det.
>
> io.maybe_delete_stream_info(Stream, !IO) :-
> io.may_delete_stream_info(MayDeleteStreamInfo, !IO),
> ( MayDeleteStreamInfo \= 0 ->
> + io.lock_stream_db(!IO),
> io.get_stream_db(StreamDb0, !IO),
> map.delete(StreamDb0, get_stream_id(Stream), StreamDb),
> - io.set_stream_db(StreamDb, !IO)
> + io.set_stream_db(StreamDb, !IO),
> + io.unlock_stream_db(!IO)
> ;
> true
> ).
> @@ -4642,6 +4695,17 @@
> :- pragma foreign_export("IL", io.init_state(di, uo), "ML_io_init_state").
>
> io.init_state(!IO) :-
> + %
> + % In C grades the "current" streams are thread-local values, so can only be
> + % set after the MR_Context has been initialised for the initial thread.
> + %
> + io.set_input_stream(io.stdin_stream, _, !IO),
> + io.set_output_stream(io.stdout_stream, _, !IO),
> + io.stdin_binary_stream(StdinBinary, !IO),
> + io.stdout_binary_stream(StdoutBinary, !IO),
> + io.set_binary_input_stream(StdinBinary, _, !IO),
> + io.set_binary_output_stream(StdoutBinary, _, !IO),
> +
> io.gc_init(type_of(StreamDb), type_of(Globals), !IO),
> map.init(StreamDb),
> type_to_univ("<globals>", Globals),
> @@ -4792,10 +4856,10 @@
> extern MercuryFile mercury_stderr;
> extern MercuryFile mercury_stdin_binary;
> extern MercuryFile mercury_stdout_binary;
> -extern MercuryFile *mercury_current_text_input;
> -extern MercuryFile *mercury_current_text_output;
> -extern MercuryFile *mercury_current_binary_input;
> -extern MercuryFile *mercury_current_binary_output;
> +extern MR_Unsigned mercury_current_text_input_index;
> +extern MR_Unsigned mercury_current_text_output_index;
> +extern MR_Unsigned mercury_current_binary_input_index;
> +extern MR_Unsigned mercury_current_binary_output_index;
I suggest adding a new type to the runtime (a typedef for MR_Unsigned)
that makes it more obvious that these things are thread local mutables,
e.g. MR_ThreadLocalMutable (although that seems a little long.)
> #define MR_initial_io_state() 0 /* some random number */
> #define MR_final_io_state(r) ((void)0)
> @@ -4803,6 +4867,11 @@
> #define MR_update_io(r_src, r_dest) ((r_dest) = (r_src))
>
> void mercury_init_io(void);
> +MercuryFilePtr mercury_current_text_input(void);
> +MercuryFilePtr mercury_current_text_output(void);
> +MercuryFilePtr mercury_current_binary_input(void);
> +MercuryFilePtr mercury_current_binary_output(void);
> +int mercury_next_stream_id(void);
> MercuryFilePtr mercury_open(const char *filename, const char *openmode);
> void mercury_io_error(MercuryFilePtr mf, const char *format, ...);
> void mercury_output_error(MercuryFilePtr mf);
> @@ -5435,11 +5504,11 @@
> MercuryFile mercury_stdin_binary;
> MercuryFile mercury_stdout_binary;
>
> -MercuryFilePtr mercury_current_text_input = &mercury_stdin;
> -MercuryFilePtr mercury_current_text_output = &mercury_stdout;
> -MercuryFilePtr mercury_current_binary_input = &mercury_stdin_binary;
> -MercuryFilePtr mercury_current_binary_output = &mercury_stdout_binary;
> -
> +MR_Unsigned mercury_current_text_input_index;
> +MR_Unsigned mercury_current_text_output_index;
> +MR_Unsigned mercury_current_binary_input_index;
> +MR_Unsigned mercury_current_binary_output_index;
> +
> void
> mercury_init_io(void)
> {
> @@ -5450,6 +5519,11 @@
> MR_mercuryfile_init(NULL, 1, &mercury_stdin_binary);
> MR_mercuryfile_init(NULL, 1, &mercury_stdout_binary);
>
> + mercury_current_text_input_index = MR_new_thread_local_mutable_index();
> + mercury_current_text_output_index = MR_new_thread_local_mutable_index();
> + mercury_current_binary_input_index = MR_new_thread_local_mutable_index();
> + mercury_current_binary_output_index = MR_new_thread_local_mutable_index();
> +
> #if defined(MR_HAVE_FDOPEN) && (defined(MR_HAVE_FILENO) || defined(fileno)) && \
> defined(MR_HAVE_DUP)
> MR_file(mercury_stdin_binary) = fdopen(dup(fileno(stdin)), ""rb"");
> @@ -5474,10 +5548,57 @@
> #endif
>
> #ifdef MR_THREAD_SAFE
> + pthread_mutex_init(&ML_io_stream_db_lock, MR_MUTEX_ATTR);
> pthread_mutex_init(&ML_io_user_globals_lock, MR_MUTEX_ATTR);
> + pthread_mutex_init(&ML_io_next_stream_id_lock, MR_MUTEX_ATTR);
> #endif
> }
>
> +MercuryFilePtr
> +mercury_current_text_input(void)
> +{
> + MercuryFilePtr stream;
> + MR_get_thread_local_mutable(MercuryFilePtr, stream,
> + mercury_current_text_input_index);
> + return stream;
> +}
> +
> +MercuryFilePtr
> +mercury_current_text_output(void)
> +{
> + MercuryFilePtr stream;
> + MR_get_thread_local_mutable(MercuryFilePtr, stream,
> + mercury_current_text_output_index);
> + return stream;
> +}
> +
> +MercuryFilePtr
> +mercury_current_binary_input(void)
> +{
> + MercuryFilePtr stream;
> + MR_get_thread_local_mutable(MercuryFilePtr, stream,
> + mercury_current_binary_input_index);
> + return stream;
> +}
> +
> +MercuryFilePtr
> +mercury_current_binary_output(void)
> +{
> + MercuryFilePtr stream;
> + MR_get_thread_local_mutable(MercuryFilePtr, stream,
> + mercury_current_binary_output_index);
> + return stream;
> +}
> +
> +int
> +mercury_next_stream_id(void)
> +{
> + int id;
> + MR_LOCK(&ML_io_next_stream_id_lock, ""io.do_open_text"");
> + id = ML_next_stream_id++;
> + MR_UNLOCK(&ML_io_next_stream_id_lock, ""io.do_open_text"");
> + return id;
> +}
> ").
>
> :- pragma foreign_code("C#", "
> @@ -5521,6 +5642,7 @@
> mercury_file_init(System.Console.OpenStandardOutput(),
> null, System.Console.Out, ML_file_encoding_kind.ML_raw_binary);
>
> +// Note: these are set again in io.init_state.
Use /* ... */ in preference to //. (We should try to maintain
support for C compilers other than gcc - and some C compilers have not
made much headway in supporting C99.)
> Index: library/list.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/library/list.m,v
> retrieving revision 1.162
> diff -u -r1.162 list.m
> --- library/list.m 18 Jan 2007 07:33:03 -0000 1.162
> +++ library/list.m 30 Jan 2007 02:25:57 -0000
> @@ -189,7 +189,7 @@
> % list.split_list(Len, List, Start, End):
> %
> % splits `List' into a prefix `Start' of length `Len', and a remainder
> - % `End'. See also: list.take, list.drop.
> + % `End'. See also: list.take, list.drop, list.split_upto.
list.drop and list.split_upto.
Julien.
--------------------------------------------------------------------------
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