Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/cm/concur/concur.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/concur/concur.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 464, Tue Nov 9 06:49:52 1999 UTC revision 478, Thu Nov 11 03:02:05 1999 UTC
# Line 17  Line 17 
17   *)   *)
18  signature CONCUR = sig  signature CONCUR = sig
19    
20        (* "private" is essentially the same as "unit", but we use it
21         * to make sure that only "pcond"-generated conditions are
22         * going to be explicitly signalled via "signal" *)
23        type private
24    
25      type 'a cond                        (* condition with value *)      type 'a cond                        (* condition with value *)
26    
27      val fork : (unit -> 'a) -> 'a cond  (* termination condition with value      val fork : (unit -> 'a) -> 'a cond  (* termination condition with value
# Line 28  Line 33 
33                                           * when waiting using "wait") *)                                           * when waiting using "wait") *)
34    
35      val inputReady : TextIO.instream -> unit cond      val inputReady : TextIO.instream -> unit cond
36      val ucond : unit -> unit cond  
37      val signal : unit cond -> unit      val pcond : unit -> private cond
38        val signal : private cond -> unit
39    
40      (* forget all waiting threads and input conditions *)      (* forget all waiting threads and input conditions *)
41      val reset : unit -> unit      val reset : unit -> unit
# Line 37  Line 43 
43    
44  structure Concur :> CONCUR = struct  structure Concur :> CONCUR = struct
45    
46        type private = unit
47    
48      type tstate = unit SMLofNJ.Cont.cont * int      type tstate = unit SMLofNJ.Cont.cont * int
49    
50      datatype 'a cstate =      datatype 'a cstate =
# Line 71  Line 79 
79        | wakeup (r as ref (Waiting tsl), v) =        | wakeup (r as ref (Waiting tsl), v) =
80          (r := Arrived v; app (fn ts => enqueue (ts, runable)) tsl)          (r := Arrived v; app (fn ts => enqueue (ts, runable)) tsl)
81    
82      fun ucond () = (ref (Waiting [])) : unit cond      fun pcond () = (ref (Waiting [])) : private cond
83      fun signal (ref (Arrived ())) = ()      fun signal (ref (Arrived ())) = ()
84        | signal uc = wakeup (uc, ())        | signal uc = wakeup (uc, ())
85    
# Line 122  Line 130 
130      fun fork worker = let      fun fork worker = let
131          val c = ref (Waiting [])          val c = ref (Waiting [])
132      in      in
         (* We give new workers a low priority so that any threads that  
          * were already running but are now waiting for some event  
          * get control first if they are re-enabled.  This is because  
          * waiting threads will clean up after errors in which case  
          * we don't want new threads to run off. *)  
133          SMLofNJ.Cont.callcc (fn return =>          SMLofNJ.Cont.callcc (fn return =>
134            (SMLofNJ.Cont.callcc (fn ts => (enqueue ((ts, ~1), runable);            (SMLofNJ.Cont.callcc (fn ts => (enqueue ((ts, ~1), runable);
135                                            SMLofNJ.Cont.throw return c));                                            SMLofNJ.Cont.throw return c));

Legend:
Removed from v.464  
changed lines
  Added in v.478

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0