[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