[m-rev.] for review: move more concurrency modules to stdlib

Peter Wang wangp at students.csse.unimelb.edu.au
Tue Jan 30 17:38:58 AEDT 2007


Branches: main

library/Mercury.options:
library/library.m:
library/thread.channel.m:
library/thread.mvar.m:
library/thread.semaphore.m:
	Move the concurrency-related modules `channel', `mvar' and
	`semaphore' from extras/concurrency into the standard library.

	Make thread.mvar use the standard library module mutvar instead of
	providing its own implementation of the same thing.

library/mutvar.m:
	Add predicate `new_mutvar0' which is like `new_mutvar' but does not
	require an initial value for the mutvar.  This is needed for
	thread.mvar.
	
	Define `new_mutvar' in terms of `new_mutvar0' and `set_mutvar'.

extras/concurrency/channel.m:
extras/concurrency/mvar.m:
extras/concurrency/semaphore.m:
	Replace predicates to call their counterparts now in the standard
	library.

	Mark them as obsolete and add pointers to the new versions.

library/thread.m:
	Fix a bug in which a field in ML_ThreadWrapperArgs had the wrong
	pointer type.

	Allocate ML_ThreadWrapperArgs with MR_GC_* macros instead of non-GC
	versions, since it contains pointers which should be traced.


mmake has trouble building things in extras/concurrency after this
change.  When generating dependencies it thinks semaphore.m is the
source file for thread.semaphore, etc.  Would it be a problem just to
remove the forwarding modules?


Index: extras/concurrency/channel.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/concurrency/channel.m,v
retrieving revision 1.3
diff -u -r1.3 channel.m
--- extras/concurrency/channel.m	20 Apr 2006 07:32:05 -0000	1.3
+++ extras/concurrency/channel.m	30 Jan 2007 05:25:35 -0000
@@ -31,25 +31,45 @@
 
     % Initialise a channel.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.channel.init/3.
+    %
+:- pragma obsolete(channel.init/3).
 :- pred channel.init(channel(T)::out, io::di, io::uo) is det.
 
     % Put an item at the end of the channel.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.channel.put/4.
+    %
+:- pragma obsolete(channel.put/4).
 :- pred channel.put(channel(T)::in, T::in, io::di, io::uo) is det.
 
     % Take an item from the start of the channel, block if there is
     % nothing in the channel.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.channel.take/4.
+    %
+:- pragma obsolete(channel.take/4).
 :- pred channel.take(channel(T)::in, T::out, io::di, io::uo) is det.
 
     % Duplicate a channel.  The new channel sees all (and only) the
     % data written to the channel after the channel.duplicate call.
+    %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.channel.duplicate/4.
     % 
+:- pragma obsolete(channel.duplicate/4).
 :- pred channel.duplicate(channel(T)::in, channel(T)::out, io::di, io::uo)
     is det.
 
     % Place an item back at the start of the channel.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.channel.untake/4.
+    %
+:- pragma obsolete(channel.untake/4).
 :- pred channel.untake(channel(T)::in, T::in, io::di, io::uo) is det.
 
 %-----------------------------------------------------------------------------%
@@ -57,53 +77,27 @@
 
 :- implementation.
 
-:- import_module mvar.
+:- use_module thread.
+:- use_module thread.channel.
 
 %-----------------------------------------------------------------------------%
 
-:- type channel(T)
-    --->    channel(
-                mvar(stream(T)),    % Read end.
-                mvar(stream(T))     % Write end.
-            ).
-
-:- type stream(T) == mvar(item(T)).
-
-:- type item(T)
-    --->    item(
-                T,          % The current item.
-                stream(T)   % The rest of the stream.
-            ).
-
-channel.init(channel(Read, Write), !IO) :-
-    mvar.init(Read, !IO),
-    mvar.init(Write, !IO),
-    mvar.init(Hole, !IO),
-    mvar.put(Read, Hole, !IO),
-    mvar.put(Write, Hole, !IO).
-
-channel.put(channel(_Read, Write), Val, !IO) :-
-    mvar.init(NewHole, !IO),
-    mvar.take(Write, OldHole, !IO),
-    mvar.put(Write, NewHole, !IO),
-    mvar.put(OldHole, item(Val, NewHole), !IO).
-
-channel.take(channel(Read, _Write), Val, !IO) :-
-    mvar.take(Read, Head, !IO),
-    mvar.take(Head, item(Val, NewHead), !IO),
-    mvar.put(Read, NewHead, !IO).
-
-channel.duplicate(channel(_Read, Write), channel(NewRead, Write), !IO) :-
-    mvar.init(NewRead, !IO),
-    mvar.take(Write, Hole, !IO),
-    mvar.put(Write, Hole, !IO),
-    mvar.put(NewRead, Hole, !IO).
-
-channel.untake(channel(Read, _Write), Val, !IO) :-
-    mvar.init(NewHead, !IO),
-    mvar.take(Read, Head, !IO),
-    mvar.put(NewHead, item(Val, Head), !IO),
-    mvar.put(Read, NewHead, !IO).
+:- type channel(T) == thread.channel.channel(T).
+
+channel.init(Channel, !IO) :-
+    thread.channel.init(Channel, !IO).
+
+channel.put(Channel, Val, !IO) :-
+    thread.channel.put(Channel, Val, !IO).
+
+channel.take(Channel, Val, !IO) :-
+    thread.channel.take(Channel, Val, !IO).
+
+channel.duplicate(Channel, NewChannel, !IO) :-
+    thread.channel.duplicate(Channel, NewChannel, !IO).
+
+channel.untake(Channel, Val, !IO) :-
+    thread.channel.untake(Channel, Val, !IO).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: extras/concurrency/mvar.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/concurrency/mvar.m,v
retrieving revision 1.7
diff -u -r1.7 mvar.m
--- extras/concurrency/mvar.m	20 Apr 2006 07:32:06 -0000	1.7
+++ extras/concurrency/mvar.m	30 Jan 2007 03:41:07 -0000
@@ -31,16 +31,28 @@
 
     % Create an empty mvar.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.mvar.init/3.
+    %
+:- pragma obsolete(mvar.init/3).
 :- pred mvar.init(mvar(T)::out, io::di, io::uo) is det.
 
     % Take the contents of the mvar out leaving the mvar empty.
     % If the mvar is empty, block until some thread fills the mvar.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.mvar.take/4.
+    %
+:- pragma obsolete(mvar.take/4).
 :- pred mvar.take(mvar(T)::in, T::out, io::di, io::uo) is det.
 
     % Place the value of type T into an empty mvar.
     % If the mvar is full block until it becomes empty.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.mvar.put/4.
+    %
+:- pragma obsolete(mvar.put/4).
 :- pred mvar.put(mvar(T)::in, T::in, io::di, io::uo) is det.
 
 %-----------------------------------------------------------------------------%
@@ -48,118 +60,21 @@
 
 :- implementation.
 
-:- import_module semaphore.
+:- use_module thread.
+:- use_module thread.mvar.
 
 %-----------------------------------------------------------------------------%
 
-:- type mvar(T)
-    --->    mvar(
-                semaphore,  % full
-                semaphore,  % empty
-                ref(T)      % data
-            ).
-
-:- pragma promise_pure(mvar.init/3).
-mvar.init(mvar(Full, Empty, Ref), !IO) :-
-    semaphore.new(Full, !IO),
-    semaphore.new(Empty, !IO),
-    impure new_ref(Ref),
-    semaphore.signal(Empty, !IO).   % Initially a mvar starts empty.
-
-:- pragma promise_pure(mvar.take/4).
-mvar.take(mvar(Full, Empty, Ref), Data, !IO) :-
-    semaphore.wait(Full, !IO),
-    impure get_ref(Ref, Data),
-    semaphore.signal(Empty, !IO).
-
-:- pragma promise_pure(mvar.put/4).
-mvar.put(mvar(Full, Empty, Ref), Data, !IO) :-
-    semaphore.wait(Empty, !IO),
-    impure set_ref(Ref, Data),
-    semaphore.signal(Full, !IO).
-
-%---------------------------------------------------------------------------%
-%---------------------------------------------------------------------------%
-
-%  A non-backtrackably destructively modifiable reference type
+:- type mvar(T) == thread.mvar.mvar(T).
 
-%%% :- interface.
-
-:- type ref(T).
-
-    % Create an empty ref location.
-    %
-:- impure pred new_ref(ref(T)::out) is det.
+mvar.init(Mvar, !IO) :-
+    thread.mvar.init(Mvar, !IO).
 
-    % Get the value currently referred to by a reference.
-    %
-:- impure pred get_ref(ref(T)::in, T::uo) is det.
-
-    % Destructively modify a reference to refer to a new object.
-    %
-:- impure pred set_ref(ref(T)::in, T::in) is det.
-
-%%% :- implementation.
-
-    %  This type is implemented in C.
-    %
-:- pragma foreign_type(c,  ref(T), "MR_Word").
-:- pragma foreign_type(il, ref(T), "class [mvar__csharp_code]ME_Reference").
+mvar.take(Mvar, Data, !IO) :-
+    thread.mvar.take(Mvar, Data, !IO).
 
-:- pragma foreign_decl("C#", "
-    public class ME_Reference {
-        public object   val;
-    }
-").
-
-:- pragma inline(new_ref/1).
-:- pragma foreign_proc("C",
-    new_ref(Ref::out),
-    [will_not_call_mercury, thread_safe],
-"
-    MR_incr_hp_msg(Ref, 1, MR_PROC_LABEL, ""mvar.ref/1"");
-    *(MR_Word *) Ref = (MR_Word) NULL;
-").
-
-:- pragma foreign_proc("C#",
-    new_ref(Ref::out),
-    [will_not_call_mercury, thread_safe],
-"
-    Ref = new ME_Reference();
-    Ref.val = null;
-").
-
-:- pragma inline(get_ref/2).
-:- pragma foreign_proc("C",
-    get_ref(Ref::in, X::uo),
-    [will_not_call_mercury, thread_safe],
-"
-    X = *(MR_Word *) Ref;
-    *(MR_Word *) Ref = (MR_Word) NULL;
-").
-
-:- pragma foreign_proc("C#",
-    get_ref(Ref::in, X::uo),
-    [will_not_call_mercury, thread_safe],
-"
-    X = Ref.val;
-    Ref.val = null;
-").
-
-:- pragma inline(set_ref/2).
-:- pragma foreign_proc("C",
-    set_ref(Ref::in, X::in),
-   [will_not_call_mercury, thread_safe],
-"
-    *(MR_Word *) Ref = (MR_Word) X;
-").
-
-:- pragma foreign_proc("C#",
-    set_ref(Ref::in, X::in),
-    [will_not_call_mercury, thread_safe],
-"
-    Ref.val = X;
-").
+mvar.put(Mvar, Data, !IO) :-
+    thread.mvar.put(Mvar, Data, !IO).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: extras/concurrency/semaphore.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/extras/concurrency/semaphore.m,v
retrieving revision 1.18
diff -u -r1.18 semaphore.m
--- extras/concurrency/semaphore.m	30 Jan 2007 02:09:55 -0000	1.18
+++ extras/concurrency/semaphore.m	30 Jan 2007 03:41:07 -0000
@@ -31,18 +31,30 @@
     % new(Sem, !IO) creates a new semaphore `Sem' with it's counter
     % initialized to 0.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.semaphore.new/3.
+    %
+:- pragma obsolete(semaphore.new/3).
 :- pred semaphore.new(semaphore::out, io::di, io::uo) is det.
 
     % wait(Sem, !IO) blocks until the counter associated with `Sem'
     % becomes greater than 0, whereupon it wakes, decrements the
     % counter and returns.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.semaphore.wait/3.
+    %
+:- pragma obsolete(semaphore.wait/3).
 :- pred semaphore.wait(semaphore::in, io::di, io::uo) is det.
 
     % try_wait(Sem, Succ, !IO) is the same as wait/3, except that
     % instead of blocking, it binds `Succ' to a boolean indicating
     % whether the call succeeded in obtaining the semaphore or not.
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.semaphore.try_wait/4.
+    %
+:- pragma obsolete(semaphore.try_wait/4).
 :- pred semaphore.try_wait(semaphore::in, bool::out, io::di, io::uo) is det.
 
     % signal(Sem, !IO) increments the counter associated with `Sem'
@@ -50,6 +62,10 @@
     % one or more coroutines that are waiting on this semaphore (if
     % any).
     %
+    % NOTE: this predicate is obsolete.  New code should use the 
+    % standard library's version: thread.semaphore.signal/3.
+    %
+:- pragma obsolete(semaphore.signal/3).
 :- pred semaphore.signal(semaphore::in, io::di, io::uo) is det.
 
 %-----------------------------------------------------------------------------%
@@ -57,285 +73,24 @@
 
 :- implementation.
 
-%-----------------------------------------------------------------------------%
-
-:- pragma foreign_decl("C", "
-    #include <stdio.h>
-    #include ""mercury_context.h""
-    #include ""mercury_thread.h""
-
-    typedef struct ME_SEMAPHORE_STRUCT {
-        int     count;
-#ifndef MR_HIGHLEVEL_CODE
-        MR_Context  *suspended;
-#else
-  #ifdef MR_THREAD_SAFE
-        MercuryCond cond;
-  #endif 
-#endif
-#ifdef MR_THREAD_SAFE
-        MercuryLock lock;
-#endif
-    } ME_Semaphore;
-").
-
-:- pragma foreign_decl("C#", "
-public class ME_Semaphore {
-    public int count;
-}
-").
-
-:- pragma foreign_type(c,  semaphore, "ME_Semaphore *").
-:- pragma foreign_type(il, semaphore,
-        "class [semaphore__csharp_code]ME_Semaphore").
-
-:- pragma foreign_decl("C", "
-#ifdef MR_CONSERVATIVE_GC
-  void ME_finalize_semaphore(void *obj, void *cd);
-#endif
-").
+:- use_module thread.
+:- use_module thread.semaphore.
 
 %-----------------------------------------------------------------------------%
 
-:- pragma foreign_proc("C",
-    new(Semaphore::out, IO0::di, IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe],
-"
-    MR_Word sem_mem;
-    ME_Semaphore    *sem;
-
-    MR_incr_hp(sem_mem,
-        MR_round_up(sizeof(ME_Semaphore), sizeof(MR_Word)));
-    sem = (ME_Semaphore *) sem_mem;
-    sem->count = 0;
-#ifndef MR_HIGHLEVEL_CODE
-    sem->suspended = NULL;
-#else
-  #ifdef MR_THREAD_SAFE
-    pthread_cond_init(&(sem->cond), MR_COND_ATTR);
-  #endif
-#endif
-#ifdef MR_THREAD_SAFE
-    pthread_mutex_init(&(sem->lock), MR_MUTEX_ATTR);
-#endif
-
-    /*
-    ** The condvar and the mutex will need to be destroyed
-    ** when the semaphore is garbage collected.
-    */
-#ifdef MR_CONSERVATIVE_GC
-    GC_REGISTER_FINALIZER(sem, ME_finalize_semaphore, NULL, NULL, NULL);
-#endif
-
-    Semaphore = sem;
-    IO = IO0;
-").
-
-:- pragma foreign_proc("C#",
-    new(Semaphore::out, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe],
-"
-    Semaphore = new ME_Semaphore();
-    Semaphore.count = 0;
-").
-
-:- pragma foreign_code("C", "
-#ifdef MR_CONSERVATIVE_GC
-  void
-  ME_finalize_semaphore(void *obj, void *cd)
-  {
-    ME_Semaphore    *sem;
-
-    sem = (ME_Semaphore *) obj;
-
-  #ifdef MR_THREAD_SAFE
-    #ifdef MR_HIGHLEVEL_CODE
-    pthread_cond_destroy(&(sem->cond));
-    #endif
-    pthread_mutex_destroy(&(sem->lock));
-  #endif
-
-    return;
-  }
-#endif
-").
-
-    % Because semaphore.signal has a local label, we may get
-    % C compilation errors if inlining leads to multiple copies
-    % of this code.
-    % 
-    % XXX get rid of this limitation at some stage.
-    %
-:- pragma no_inline(semaphore.signal/3).
-:- pragma foreign_proc("C",
-    signal(Semaphore::in, IO0::di, IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe],
-"
-    ME_Semaphore    *sem;
-#ifndef MR_HIGHLEVEL_CODE
-    MR_Context  *ctxt;
-#endif
-
-    sem = (ME_Semaphore *) Semaphore;
-
-    MR_LOCK(&(sem->lock), ""semaphore__signal"");
-
-#ifndef MR_HIGHLEVEL_CODE
-    if (sem->count >= 0 && sem->suspended != NULL) {
-        ctxt = sem->suspended;
-        sem->suspended = ctxt->MR_ctxt_next;
-        MR_UNLOCK(&(sem->lock), ""semaphore__signal"");
-        MR_schedule_context(ctxt);
-            /* yield() */
-        MR_save_context(MR_ENGINE(MR_eng_this_context));
-        MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume =
-            &&signal_skip_to_the_end_1;
-        MR_schedule_context(MR_ENGINE(MR_eng_this_context));
-        MR_ENGINE(MR_eng_this_context) = NULL;
-        MR_runnext();
-signal_skip_to_the_end_1: ;
-    } else {
-        sem->count++;
-        MR_UNLOCK(&(sem->lock), ""semaphore__signal"");
-            /* yield() */
-        MR_save_context(MR_ENGINE(MR_eng_this_context));
-        MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume =
-            &&signal_skip_to_the_end_2;
-        MR_schedule_context(MR_ENGINE(MR_eng_this_context));
-        MR_ENGINE(MR_eng_this_context) = NULL;
-        MR_runnext();
-signal_skip_to_the_end_2: ;
-    }
-#else
-    sem->count++;
-    MR_SIGNAL(&(sem->cond));
-    MR_UNLOCK(&(sem->lock), ""semaphore__signal"");
-#endif
-    IO = IO0;
-").
-
-:- pragma foreign_proc("C#",
-    signal(Semaphore::in, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe],
-"
-    System.Threading.Monitor.Enter(Semaphore);
-    Semaphore.count++;
-        // XXX I think we only need to do a Pulse.
-    System.Threading.Monitor.PulseAll(Semaphore);
-    System.Threading.Monitor.Exit(Semaphore);
-").
-
-    % Because semaphore__wait has a local label, we may get
-    % C compilation errors if inlining leads to multiple copies
-    % of this code.
-    % 
-    % XXX get rid of this limitation at some stage.
-    %
-:- pragma no_inline(semaphore__wait/3).
-:- pragma foreign_proc("C",
-    wait(Semaphore::in, IO0::di, IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe],
-"
-    ME_Semaphore    *sem;
-#ifndef MR_HIGHLEVEL_CODE
-    MR_Context  *ctxt;
-#endif
-
-    sem = (ME_Semaphore *) Semaphore;
-
-    MR_LOCK(&(sem->lock), ""semaphore__wait"");
-
-#ifndef MR_HIGHLEVEL_CODE
-    if (sem->count > 0) {
-        sem->count--;
-        MR_UNLOCK(&(sem->lock), ""semaphore__wait"");
-    } else {
-        MR_save_context(MR_ENGINE(MR_eng_this_context));
-        MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume =
-            &&wait_skip_to_the_end;
-        MR_ENGINE(MR_eng_this_context)->MR_ctxt_next = sem->suspended;
-        sem->suspended = MR_ENGINE(MR_eng_this_context);
-        MR_UNLOCK(&(sem->lock), ""semaphore__wait"");
-        MR_ENGINE(MR_eng_this_context) = NULL;
-        MR_runnext();
-wait_skip_to_the_end: ;
-    }
-#else
-    while (sem->count <= 0) {
-        /*
-        ** Although it goes against the spec, pthread_cond_wait() can
-        ** return prematurely with the error code EINTR in glibc 2.3.2
-        ** if the thread is sent a signal.
-        */
-        while (MR_WAIT(&(sem->cond), &(sem->lock)) != 0) {
-        }
-    }
-
-    sem->count--;
-
-    MR_UNLOCK(&(sem->lock), ""semaphore__wait"");
-#endif
-    IO = IO0;
-").
-
-:- pragma foreign_proc("C#",
-    wait(Semaphore::in, _IO0::di, _IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe],
-"
-    System.Threading.Monitor.Enter(Semaphore);
-
-    while (Semaphore.count <= 0) {
-        System.Threading.Monitor.Wait(Semaphore);
-    }
+:- type semaphore == thread.semaphore.semaphore.
 
-    Semaphore.count--;
+semaphore.new(Sem, !IO) :-
+    thread.semaphore.new(Sem, !IO).
 
-    System.Threading.Monitor.Exit(Semaphore);
-").
+semaphore.signal(Sem, !IO) :-
+    thread.semaphore.signal(Sem, !IO).
 
-semaphore.try_wait(Sem, Res, !IO) :-
-    try_wait_2(Sem, Res0, !IO),
-    Res = ( Res0 = 0 -> yes ; no ).
+semaphore.wait(Sem, !IO) :-
+    thread.semaphore.wait(Sem, !IO).
 
-:- pred try_wait_2(semaphore::in, int::out, io::di, io::uo) is det.
-
-:- pragma foreign_proc("C",
-    try_wait_2(Semaphore::in, Res::out, IO0::di, IO::uo),
-    [promise_pure, will_not_call_mercury, thread_safe],
-"
-    ME_Semaphore    *sem;
-
-    sem = (ME_Semaphore *) Semaphore;
-
-    MR_LOCK(&(sem->lock), ""semaphore.try_wait"");
-    if (sem->count > 0) {
-        sem->count--;
-        MR_UNLOCK(&(sem->lock), ""semaphore.try_wait"");
-        Res = 0;
-    } else {
-        MR_UNLOCK(&(sem->lock), ""semaphore.try_wait"");
-        Res = 1;
-    }
-    IO = IO0;
-").
-
-:- pragma foreign_proc("C#",
-        try_wait_2(Semaphore::in, Res::out, _IO0::di, _IO::uo),
-        [promise_pure, will_not_call_mercury, thread_safe],
-"
-    if (System.Threading.Monitor.TryEnter(Semaphore)) {
-        if (Semaphore.count > 0) {
-            Semaphore.count--;
-            System.Threading.Monitor.Exit(Semaphore);
-            Res = 0;
-        } else {
-            System.Threading.Monitor.Exit(Semaphore);
-            Res = 1;
-        }
-    } else {
-        Res = 1;
-    }
-").
+semaphore.try_wait(Sem, Res, !IO) :-
+    thread.semaphore.try_wait(Sem, Res, !IO).
 
 %-----------------------------------------------------------------------------%
 %-----------------------------------------------------------------------------%
Index: library/library.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/library.m,v
retrieving revision 1.101
diff -u -r1.101 library.m
--- library/library.m	18 Jan 2007 04:40:54 -0000	1.101
+++ library/library.m	30 Jan 2007 05:30:24 -0000
@@ -277,6 +277,9 @@
 mercury_std_library_module("term_to_xml").
 mercury_std_library_module("time").
 mercury_std_library_module("thread").
+mercury_std_library_module("thread.channel").
+mercury_std_library_module("thread.mvar").
+mercury_std_library_module("thread.semaphore").
 mercury_std_library_module("tree234").
 mercury_std_library_module("tree_bitset").
 mercury_std_library_module("type_desc").
Index: library/mutvar.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/mutvar.m,v
retrieving revision 1.2
diff -u -r1.2 mutvar.m
--- library/mutvar.m	19 Apr 2006 05:17:53 -0000	1.2
+++ library/mutvar.m	30 Jan 2007 03:41:07 -0000
@@ -33,6 +33,11 @@
 :-        mode new_mutvar(in, out) is det.
 :-        mode new_mutvar(di, uo) is det.
 
+    % Create a new mutvar with undefined initial value.
+    %
+:- impure pred new_mutvar0(mutvar(T)).
+:-        mode new_mutvar0(uo) is det.
+
     % Get the value currently referred to by a reference.
     %
 :- impure pred get_mutvar(mutvar(T), T) is det.
@@ -58,10 +63,18 @@
 :- implementation.
 
 :- pragma inline(new_mutvar/2).
+:- pragma inline(new_mutvar0/1).
 :- pragma inline(get_mutvar/2).
 :- pragma inline(set_mutvar/2).
 
 %-----------------------------------------------------------------------------%
+
+new_mutvar(X, Ref) :-
+    impure new_mutvar0(Ref0),
+    impure set_mutvar(Ref0, X),
+    Ref = unsafe_promise_unique(Ref0).
+
+%-----------------------------------------------------------------------------%
 %
 % C implementation
 %
@@ -72,22 +85,12 @@
     --->    mutvar(private_builtin.ref(T)).
 
 :- pragma foreign_proc("C",
-    new_mutvar(X::in, Ref::out),
-    [will_not_call_mercury, thread_safe],
-"
-    MR_offset_incr_hp_msg(Ref, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
-        MR_PROC_LABEL, ""mutvar.mutvar/1"");
-    MR_define_size_slot(0, Ref, 1);
-    * (MR_Word *) Ref = X;
-").
-:- pragma foreign_proc("C",
-    new_mutvar(X::di, Ref::uo),
+    new_mutvar0(Ref::uo),
     [will_not_call_mercury, thread_safe],
 "
     MR_offset_incr_hp_msg(Ref, MR_SIZE_SLOT_SIZE, MR_SIZE_SLOT_SIZE + 1,
         MR_PROC_LABEL, ""mutvar.mutvar/1"");
     MR_define_size_slot(0, Ref, 1);
-    * (MR_Word *) Ref = X;
 ").
 
 :- pragma foreign_proc("C",
@@ -110,18 +113,10 @@
 %
 
 :- pragma foreign_proc("C#",
-    new_mutvar(X::in, Ref::out),
+    new_mutvar0(Ref::uo),
     [will_not_call_mercury, thread_safe],
 "
     Ref = new object[1];
-    Ref[0] = X;
-").
-:- pragma foreign_proc("C#",
-    new_mutvar(X::di, Ref::uo),
-    [will_not_call_mercury, thread_safe],
-"
-    Ref = new object[1];
-    Ref[0] = X;
 ").
 
 :- pragma foreign_proc("C#",
@@ -147,26 +142,16 @@
 "
     public static class Mutvar {
         public Object object;
-
-        public Mutvar(Object init) {
-            object = init;
-        }
     }
 ").
 
 :- pragma foreign_type("Java", mutvar(T), "mercury.mutvar.Mutvar").
 
 :- pragma foreign_proc("Java",
-    new_mutvar(X::in, Ref::out),
-    [will_not_call_mercury, thread_safe],
-"
-    Ref = new mercury.mutvar.Mutvar(X);
-").
-:- pragma foreign_proc("Java",
-    new_mutvar(X::di, Ref::uo),
+    new_mutvar0(Ref::uo),
     [will_not_call_mercury, thread_safe],
 "
-    Ref = new mercury.mutvar.Mutvar(X);
+    Ref = new mercury.mutvar.Mutvar();
 ").
 
 :- pragma foreign_proc("Java",
Index: library/thread.channel.m
===================================================================
RCS file: library/thread.channel.m
diff -N library/thread.channel.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ library/thread.channel.m	30 Jan 2007 03:41:07 -0000
@@ -0,0 +1,109 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000-2001, 2006 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% File: thread.channel.m.
+% Main author: petdr.
+% Stability: low.
+%
+% A mvar can only contain a single value, a channel on the other hand provides
+% unbounded buffering.
+%
+% For example a program could consist of 2 worker threads and one logging
+% thread.  The worker threads can place messages into the channel, and they
+% will be buffered for processing by the logging thread.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module thread.channel.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- type channel(T).
+
+    % Initialise a channel.
+    %
+:- pred channel.init(channel(T)::out, io::di, io::uo) is det.
+
+    % Put an item at the end of the channel.
+    %
+:- pred channel.put(channel(T)::in, T::in, io::di, io::uo) is det.
+
+    % Take an item from the start of the channel, block if there is
+    % nothing in the channel.
+    %
+:- pred channel.take(channel(T)::in, T::out, io::di, io::uo) is det.
+
+    % Duplicate a channel.  The new channel sees all (and only) the
+    % data written to the channel after the channel.duplicate call.
+    % 
+:- pred channel.duplicate(channel(T)::in, channel(T)::out, io::di, io::uo)
+    is det.
+
+    % Place an item back at the start of the channel.
+    %
+:- pred channel.untake(channel(T)::in, T::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module thread.mvar.
+
+%-----------------------------------------------------------------------------%
+
+:- type channel(T)
+    --->    channel(
+                mvar(stream(T)),    % Read end.
+                mvar(stream(T))     % Write end.
+            ).
+
+:- type stream(T) == mvar(item(T)).
+
+:- type item(T)
+    --->    item(
+                T,          % The current item.
+                stream(T)   % The rest of the stream.
+            ).
+
+channel.init(channel(Read, Write), !IO) :-
+    mvar.init(Read, !IO),
+    mvar.init(Write, !IO),
+    mvar.init(Hole, !IO),
+    mvar.put(Read, Hole, !IO),
+    mvar.put(Write, Hole, !IO).
+
+channel.put(channel(_Read, Write), Val, !IO) :-
+    mvar.init(NewHole, !IO),
+    mvar.take(Write, OldHole, !IO),
+    mvar.put(Write, NewHole, !IO),
+    mvar.put(OldHole, item(Val, NewHole), !IO).
+
+channel.take(channel(Read, _Write), Val, !IO) :-
+    mvar.take(Read, Head, !IO),
+    mvar.take(Head, item(Val, NewHead), !IO),
+    mvar.put(Read, NewHead, !IO).
+
+channel.duplicate(channel(_Read, Write), channel(NewRead, Write), !IO) :-
+    mvar.init(NewRead, !IO),
+    mvar.take(Write, Hole, !IO),
+    mvar.put(Write, Hole, !IO),
+    mvar.put(NewRead, Hole, !IO).
+
+channel.untake(channel(Read, _Write), Val, !IO) :-
+    mvar.init(NewHead, !IO),
+    mvar.take(Read, Head, !IO),
+    mvar.put(NewHead, item(Val, Head), !IO),
+    mvar.put(Read, NewHead, !IO).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: library/thread.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/thread.m,v
retrieving revision 1.1
diff -u -r1.1 thread.m
--- library/thread.m	18 Jan 2007 04:40:54 -0000	1.1
+++ library/thread.m	30 Jan 2007 03:41:07 -0000
@@ -24,6 +24,10 @@
 
 :- import_module io.
 
+:- include_module channel.
+:- include_module mvar.
+:- include_module semaphore.
+
 %-----------------------------------------------------------------------------%
 
     % spawn(Closure, IO0, IO) is true iff `IO0' denotes a list of I/O
@@ -142,8 +146,8 @@
 
   typedef struct ML_ThreadWrapperArgs ML_ThreadWrapperArgs;
   struct ML_ThreadWrapperArgs {
-        MR_Word     goal;
-        MR_Word     *thread_local_mutables;
+        MR_Word             goal;
+        MR_ThreadLocalMuts  *thread_local_mutables;
   };
 #endif /* MR_HIGHLEVEL_CODE && MR_THREAD_SAFE */
 ").
@@ -160,7 +164,7 @@
     ** before the child thread has got all the information it needs out of the
     ** structure.
     */
-    args = MR_malloc(sizeof(ML_ThreadWrapperArgs));
+    args = MR_GC_NEW_UNCOLLECTABLE(ML_ThreadWrapperArgs);
     args->goal = goal;
     args->thread_local_mutables =
         MR_clone_thread_local_mutables(MR_THREAD_LOCAL_MUTABLES);
@@ -190,7 +194,7 @@
     MR_SET_THREAD_LOCAL_MUTABLES(args->thread_local_mutables);
 
     goal = args->goal;
-    MR_free(args);
+    MR_GC_free(args);
 
     ML_call_back_to_mercury_cc_multi(goal);
 
Index: library/thread.mvar.m
===================================================================
RCS file: library/thread.mvar.m
diff -N library/thread.mvar.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ library/thread.mvar.m	30 Jan 2007 03:41:07 -0000
@@ -0,0 +1,83 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000-2003, 2006 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB
+%-----------------------------------------------------------------------------%
+%
+% File: thread.mvar.m.
+% Main author: petdr, fjh.
+% Stability: low.
+%
+% This module provides a Mercury version of Haskell mutable variables.  A
+% mutable variable (mvar) is a reference to a mutable location which can
+% either contain a value of type T or be empty.
+%
+% Access to a mvar is thread-safe and can be used to synchronize between
+% different threads.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module thread.mvar.
+:- interface.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- type mvar(T).
+
+    % Create an empty mvar.
+    %
+:- pred mvar.init(mvar(T)::out, io::di, io::uo) is det.
+
+    % Take the contents of the mvar out leaving the mvar empty.
+    % If the mvar is empty, block until some thread fills the mvar.
+    %
+:- pred mvar.take(mvar(T)::in, T::out, io::di, io::uo) is det.
+
+    % Place the value of type T into an empty mvar.
+    % If the mvar is full block until it becomes empty.
+    %
+:- pred mvar.put(mvar(T)::in, T::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module mutvar.
+:- import_module thread.semaphore.
+
+%-----------------------------------------------------------------------------%
+
+:- type mvar(T)
+    --->    mvar(
+                semaphore,  % full
+                semaphore,  % empty
+                mutvar(T)   % data
+            ).
+
+:- pragma promise_pure(mvar.init/3).
+mvar.init(mvar(Full, Empty, Ref), !IO) :-
+    semaphore.new(Full, !IO),
+    semaphore.new(Empty, !IO),
+    impure new_mutvar0(Ref),
+    semaphore.signal(Empty, !IO).   % Initially a mvar starts empty.
+
+:- pragma promise_pure(mvar.take/4).
+mvar.take(mvar(Full, Empty, Ref), Data, !IO) :-
+    semaphore.wait(Full, !IO),
+    impure get_mutvar(Ref, Data),
+    semaphore.signal(Empty, !IO).
+
+:- pragma promise_pure(mvar.put/4).
+mvar.put(mvar(Full, Empty, Ref), Data, !IO) :-
+    semaphore.wait(Empty, !IO),
+    impure set_mutvar(Ref, Data),
+    semaphore.signal(Full, !IO).
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
Index: library/thread.semaphore.m
===================================================================
RCS file: library/thread.semaphore.m
diff -N library/thread.semaphore.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ library/thread.semaphore.m	30 Jan 2007 03:41:07 -0000
@@ -0,0 +1,341 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2000-2001,2003-2004, 2006-2007 The University of Melbourne.
+% This file may only be copied under the terms of the GNU Library General
+% Public License - see the file COPYING.LIB in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% File: thread.semaphore.m.
+% Main author: conway
+% Stability: medium.
+%
+% This module implements a simple semaphore data type for allowing
+% coroutines to synchronise with one another.
+%
+% The operations in this module are no-ops in the hlc grades which don't
+% contain a .par component.
+%
+%-----------------------------------------------------------------------------%
+
+:- module thread.semaphore.
+:- interface.
+
+:- import_module bool.
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- type semaphore.
+
+    % new(Sem, !IO) creates a new semaphore `Sem' with it's counter
+    % initialized to 0.
+    %
+:- pred semaphore.new(semaphore::out, io::di, io::uo) is det.
+
+    % wait(Sem, !IO) blocks until the counter associated with `Sem'
+    % becomes greater than 0, whereupon it wakes, decrements the
+    % counter and returns.
+    %
+:- pred semaphore.wait(semaphore::in, io::di, io::uo) is det.
+
+    % try_wait(Sem, Succ, !IO) is the same as wait/3, except that
+    % instead of blocking, it binds `Succ' to a boolean indicating
+    % whether the call succeeded in obtaining the semaphore or not.
+    %
+:- pred semaphore.try_wait(semaphore::in, bool::out, io::di, io::uo) is det.
+
+    % signal(Sem, !IO) increments the counter associated with `Sem'
+    % and if the resulting counter has a value greater than 0, it wakes
+    % one or more coroutines that are waiting on this semaphore (if
+    % any).
+    %
+:- pred semaphore.signal(semaphore::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_decl("C", "
+    #include <stdio.h>
+    #include ""mercury_context.h""
+    #include ""mercury_thread.h""
+
+    typedef struct ME_SEMAPHORE_STRUCT {
+        int     count;
+#ifndef MR_HIGHLEVEL_CODE
+        MR_Context  *suspended;
+#else
+  #ifdef MR_THREAD_SAFE
+        MercuryCond cond;
+  #endif 
+#endif
+#ifdef MR_THREAD_SAFE
+        MercuryLock lock;
+#endif
+    } ME_Semaphore;
+").
+
+:- pragma foreign_decl("C#", "
+public class ME_Semaphore {
+    public int count;
+}
+").
+
+:- pragma foreign_type(c,  semaphore, "ME_Semaphore *").
+:- pragma foreign_type(il, semaphore,
+        "class [semaphore__csharp_code]ME_Semaphore").
+
+:- pragma foreign_decl("C", "
+#ifdef MR_CONSERVATIVE_GC
+  void ME_finalize_semaphore(void *obj, void *cd);
+#endif
+").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma foreign_proc("C",
+    new(Semaphore::out, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    MR_Word sem_mem;
+    ME_Semaphore    *sem;
+
+    MR_incr_hp(sem_mem,
+        MR_round_up(sizeof(ME_Semaphore), sizeof(MR_Word)));
+    sem = (ME_Semaphore *) sem_mem;
+    sem->count = 0;
+#ifndef MR_HIGHLEVEL_CODE
+    sem->suspended = NULL;
+#else
+  #ifdef MR_THREAD_SAFE
+    pthread_cond_init(&(sem->cond), MR_COND_ATTR);
+  #endif
+#endif
+#ifdef MR_THREAD_SAFE
+    pthread_mutex_init(&(sem->lock), MR_MUTEX_ATTR);
+#endif
+
+    /*
+    ** The condvar and the mutex will need to be destroyed
+    ** when the semaphore is garbage collected.
+    */
+#ifdef MR_CONSERVATIVE_GC
+    GC_REGISTER_FINALIZER(sem, ME_finalize_semaphore, NULL, NULL, NULL);
+#endif
+
+    Semaphore = sem;
+    IO = IO0;
+").
+
+:- pragma foreign_proc("C#",
+    new(Semaphore::out, _IO0::di, _IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    Semaphore = new ME_Semaphore();
+    Semaphore.count = 0;
+").
+
+:- pragma foreign_code("C", "
+#ifdef MR_CONSERVATIVE_GC
+  void
+  ME_finalize_semaphore(void *obj, void *cd)
+  {
+    ME_Semaphore    *sem;
+
+    sem = (ME_Semaphore *) obj;
+
+  #ifdef MR_THREAD_SAFE
+    #ifdef MR_HIGHLEVEL_CODE
+    pthread_cond_destroy(&(sem->cond));
+    #endif
+    pthread_mutex_destroy(&(sem->lock));
+  #endif
+
+    return;
+  }
+#endif
+").
+
+    % Because semaphore.signal has a local label, we may get
+    % C compilation errors if inlining leads to multiple copies
+    % of this code.
+    % 
+    % XXX get rid of this limitation at some stage.
+    %
+:- pragma no_inline(semaphore.signal/3).
+:- pragma foreign_proc("C",
+    signal(Semaphore::in, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    ME_Semaphore    *sem;
+#ifndef MR_HIGHLEVEL_CODE
+    MR_Context  *ctxt;
+#endif
+
+    sem = (ME_Semaphore *) Semaphore;
+
+    MR_LOCK(&(sem->lock), ""semaphore__signal"");
+
+#ifndef MR_HIGHLEVEL_CODE
+    if (sem->count >= 0 && sem->suspended != NULL) {
+        ctxt = sem->suspended;
+        sem->suspended = ctxt->MR_ctxt_next;
+        MR_UNLOCK(&(sem->lock), ""semaphore__signal"");
+        MR_schedule_context(ctxt);
+            /* yield() */
+        MR_save_context(MR_ENGINE(MR_eng_this_context));
+        MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume =
+            &&signal_skip_to_the_end_1;
+        MR_schedule_context(MR_ENGINE(MR_eng_this_context));
+        MR_ENGINE(MR_eng_this_context) = NULL;
+        MR_runnext();
+signal_skip_to_the_end_1: ;
+    } else {
+        sem->count++;
+        MR_UNLOCK(&(sem->lock), ""semaphore__signal"");
+            /* yield() */
+        MR_save_context(MR_ENGINE(MR_eng_this_context));
+        MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume =
+            &&signal_skip_to_the_end_2;
+        MR_schedule_context(MR_ENGINE(MR_eng_this_context));
+        MR_ENGINE(MR_eng_this_context) = NULL;
+        MR_runnext();
+signal_skip_to_the_end_2: ;
+    }
+#else
+    sem->count++;
+    MR_SIGNAL(&(sem->cond));
+    MR_UNLOCK(&(sem->lock), ""semaphore__signal"");
+#endif
+    IO = IO0;
+").
+
+:- pragma foreign_proc("C#",
+    signal(Semaphore::in, _IO0::di, _IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    System.Threading.Monitor.Enter(Semaphore);
+    Semaphore.count++;
+        // XXX I think we only need to do a Pulse.
+    System.Threading.Monitor.PulseAll(Semaphore);
+    System.Threading.Monitor.Exit(Semaphore);
+").
+
+    % Because semaphore__wait has a local label, we may get
+    % C compilation errors if inlining leads to multiple copies
+    % of this code.
+    % 
+    % XXX get rid of this limitation at some stage.
+    %
+:- pragma no_inline(semaphore__wait/3).
+:- pragma foreign_proc("C",
+    wait(Semaphore::in, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    ME_Semaphore    *sem;
+#ifndef MR_HIGHLEVEL_CODE
+    MR_Context  *ctxt;
+#endif
+
+    sem = (ME_Semaphore *) Semaphore;
+
+    MR_LOCK(&(sem->lock), ""semaphore__wait"");
+
+#ifndef MR_HIGHLEVEL_CODE
+    if (sem->count > 0) {
+        sem->count--;
+        MR_UNLOCK(&(sem->lock), ""semaphore__wait"");
+    } else {
+        MR_save_context(MR_ENGINE(MR_eng_this_context));
+        MR_ENGINE(MR_eng_this_context)->MR_ctxt_resume =
+            &&wait_skip_to_the_end;
+        MR_ENGINE(MR_eng_this_context)->MR_ctxt_next = sem->suspended;
+        sem->suspended = MR_ENGINE(MR_eng_this_context);
+        MR_UNLOCK(&(sem->lock), ""semaphore__wait"");
+        MR_ENGINE(MR_eng_this_context) = NULL;
+        MR_runnext();
+wait_skip_to_the_end: ;
+    }
+#else
+    while (sem->count <= 0) {
+        /*
+        ** Although it goes against the spec, pthread_cond_wait() can
+        ** return prematurely with the error code EINTR in glibc 2.3.2
+        ** if the thread is sent a signal.
+        */
+        while (MR_WAIT(&(sem->cond), &(sem->lock)) != 0) {
+        }
+    }
+
+    sem->count--;
+
+    MR_UNLOCK(&(sem->lock), ""semaphore__wait"");
+#endif
+    IO = IO0;
+").
+
+:- pragma foreign_proc("C#",
+    wait(Semaphore::in, _IO0::di, _IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    System.Threading.Monitor.Enter(Semaphore);
+
+    while (Semaphore.count <= 0) {
+        System.Threading.Monitor.Wait(Semaphore);
+    }
+
+    Semaphore.count--;
+
+    System.Threading.Monitor.Exit(Semaphore);
+").
+
+semaphore.try_wait(Sem, Res, !IO) :-
+    try_wait_2(Sem, Res0, !IO),
+    Res = ( Res0 = 0 -> yes ; no ).
+
+:- pred try_wait_2(semaphore::in, int::out, io::di, io::uo) is det.
+
+:- pragma foreign_proc("C",
+    try_wait_2(Semaphore::in, Res::out, IO0::di, IO::uo),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    ME_Semaphore    *sem;
+
+    sem = (ME_Semaphore *) Semaphore;
+
+    MR_LOCK(&(sem->lock), ""semaphore.try_wait"");
+    if (sem->count > 0) {
+        sem->count--;
+        MR_UNLOCK(&(sem->lock), ""semaphore.try_wait"");
+        Res = 0;
+    } else {
+        MR_UNLOCK(&(sem->lock), ""semaphore.try_wait"");
+        Res = 1;
+    }
+    IO = IO0;
+").
+
+:- pragma foreign_proc("C#",
+        try_wait_2(Semaphore::in, Res::out, _IO0::di, _IO::uo),
+        [promise_pure, will_not_call_mercury, thread_safe],
+"
+    if (System.Threading.Monitor.TryEnter(Semaphore)) {
+        if (Semaphore.count > 0) {
+            Semaphore.count--;
+            System.Threading.Monitor.Exit(Semaphore);
+            Res = 0;
+        } else {
+            System.Threading.Monitor.Exit(Semaphore);
+            Res = 1;
+        }
+    } else {
+        Res = 1;
+    }
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: library/Mercury.options
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/Mercury.options,v
retrieving revision 1.21
diff -u -r1.21 Mercury.options
--- library/Mercury.options	23 Jan 2007 02:49:50 -0000	1.21
+++ library/Mercury.options	30 Jan 2007 06:04:54 -0000
@@ -67,3 +67,4 @@
 # the right places is tricky (i.e. I gave up).
 #
 MCFLAGS-thread += --no-local-thread-engine-base
+MCFLAGS-thread.semaphore += --no-local-thread-engine-base
--------------------------------------------------------------------------
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