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/cml/src/core-cml/event.sml
ViewVC logotype

Diff of /sml/trunk/src/cml/src/core-cml/event.sml

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

revision 3, Sat Oct 4 23:33:46 1997 UTC revision 8, Sun Jan 18 01:01:29 1998 UTC
# Line 65  Line 65 
65    
66      fun error msg = raise Fail msg      fun error msg = raise Fail msg
67    
68      structure Rep : sig      datatype event_status = datatype RepTypes.event_status
69          datatype 'a event_status      type 'a base_evt = 'a RepTypes.base_evt
70            = ENABLED of {prio : int, doFn : unit -> 'a}      datatype event = datatype RepTypes.event
           | BLOCKED of {  
                 transId : R.trans_id ref, cleanUp : unit -> unit, next : unit -> unit  
               } -> 'a  
         type 'a base_evt (* = unit -> 'a event_status *)  
         datatype 'a event  
           = BEVT of 'a base_evt list  
           | CHOOSE of 'a event list  
           | GUARD of unit -> 'a event  
           | W_NACK of unit event -> 'a event  
       end = RepTypes  
     open Rep  
71    
72    
73    (** Condition variables.  Because these variables are set inside atomic    (** Condition variables.  Because these variables are set inside atomic
# Line 93  Line 82 
82    (* set a condition variable; we assume that this function is always    (* set a condition variable; we assume that this function is always
83     * executed in an atomic region.     * executed in an atomic region.
84     *)     *)
85      fun atomicCVarSet (R.CVAR(ref(R.CVAR_unset waiting))) = let      fun atomicCVarSet (R.CVAR state) = (case !state
86               of (R.CVAR_unset waiting) => let
87            val R.Q{rear, ...} = S.rdyQ1            val R.Q{rear, ...} = S.rdyQ1
88            fun add [] = !rear            fun add [] = !rear
89              | add ({transId=ref R.CANCEL, ...}::r) = add r              | add ({transId=ref R.CANCEL, ...}::r) = add r
# Line 102  Line 92 
92                  cleanUp();                  cleanUp();
93                  (tid, kont) :: (add r))                  (tid, kont) :: (add r))
94            in            in
95                      state := R.CVAR_set 1;
96              rear := add waiting              rear := add waiting
97            end            end
98        | atomicCVarSet (R.CVAR _) = error "cvar already set"              | _ => error "cvar already set"
99              (* end case *))
100    
101    (* the event constructor for waiting on a cvar *)    (* the event constructor for waiting on a cvar *)
102      fun cvarGetEvt (R.CVAR(state)) = let      fun cvarGetEvt (R.CVAR(state)) = let
# Line 116  Line 108 
108                    next ()                    next ()
109                  end)                  end)
110            fun pollFn () = (case !state            fun pollFn () = (case !state
111                   of (R.CVAR_set n) => (                   of (R.CVAR_set n) => let
112                          fun doFn () = (state := R.CVAR_set 1; S.atomicEnd())
113                          in
114                        state := R.CVAR_set(n+1);                        state := R.CVAR_set(n+1);
115                        ENABLED{prio=n, doFn=S.atomicEnd})                          ENABLED{prio=n, doFn=doFn}
116                          end
117                    | _ => BLOCKED blockFn                    | _ => BLOCKED blockFn
118                  (* end case *))                  (* end case *))
119            in            in

Legend:
Removed from v.3  
changed lines
  Added in v.8

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