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 843, Tue Jun 19 21:53:04 2001 UTC revision 844, Wed Jun 20 20:39:15 2001 UTC
# Line 82  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 state) = (case !state      fun atomicCVarSet (R.CVAR state) = (
86              case !state
87             of (R.CVAR_unset waiting) => let             of (R.CVAR_unset waiting) => let
88                  val R.Q{rear, ...} = S.rdyQ1                  val R.Q{rear, ...} = S.rdyQ1
89                  fun add [] = !rear                  fun add [] = !rear
# Line 180  Line 181 
181        | GRP of 'a event_group list        | GRP of 'a event_group list
182        | NACK_GRP of (R.cvar * 'a event_group)        | NACK_GRP of (R.cvar * 'a event_group)
183    
184    (*+DEBUG
185    fun sayGrp (msg, eg) = let
186          fun f (BASE_GRP l, sl) = "BASE_GRP("::Int.toString(List.length l)::")"::sl
187            | f (GRP l, sl) = "GRP(" :: g(l, ")"::sl)
188            | f (NACK_GRP l, sl) = "NACK_GRP(" :: f(#2 l, ")"::sl)
189          and g ([], sl) = sl
190            | g ([x], sl) = f(x, sl)
191            | g (x::r, sl) = f(x, "," :: g(r, sl))
192          in
193            Debug.sayDebugId(String.concat(msg :: ": " :: f(eg, ["\n"])))
194          end
195    -DEBUG*)
196    
197    (* force the evaluation of any guards in an event group. *)    (* force the evaluation of any guards in an event group. *)
198      fun force (BEVT l) = BASE_GRP l      fun force (BEVT l) = BASE_GRP l
199        | force evt = let        | force evt = let
# Line 292  Line 306 
306            end            end
307    
308    (* walk the event group tree, collecting the base events (with associated    (* walk the event group tree, collecting the base events (with associated
309     * ack flags), and a list of (cvar * ack flag set) pairs.     * ack flags), and a list of flag sets.  A flag set is a (cvar * ack flag list)
310       * pairs, where the flags are those associated with the events covered by the
311       * nack cvar.
312     *)     *)
313      fun collect grp = let      fun collect grp = let
314            val unWrappedFlg = ref false            val unWrappedFlg = ref false
# Line 304  Line 320 
320                              in                              in
321                                append (r, (bev, flg)::bl, flg::allFlgs)                                append (r, (bev, flg)::bl, flg::allFlgs)
322                              end                              end
323                        val (bl', allFlgs') = append (bevs, [], allFlgs)                        val (bl', allFlgs') = append (bevs, bl, allFlgs)
324                        in                        in
325                          (bl', allFlgs', flgSets)                          (bl', allFlgs', flgSets)
326                        end                        end
# Line 316  Line 332 
332                        end                        end
333                    | gather (NACK_GRP(cvar, grp), bl, allFlgs, flgSets) = let                    | gather (NACK_GRP(cvar, grp), bl, allFlgs, flgSets) = let
334                        val (bl', allFlgs', flgSets') =                        val (bl', allFlgs', flgSets') =
335                              gather (grp, bl, allFlgs, flgSets)                              gather (grp, bl, [], flgSets)
336                        in                        in
337                          (bl', allFlgs', (cvar, allFlgs') :: flgSets')                          (bl', allFlgs' @ allFlgs, (cvar, allFlgs') :: flgSets')
338                        end                        end
339                  val (bl, _, flgSets) = gather (grp, bl, [], flgSets)                  val (bl, _, flgSets) = gather (grp, bl, [], flgSets)
340                  in                  in
# Line 353  Line 369 
369      fun syncOnGrp grp = let      fun syncOnGrp grp = let
370            val (bl, flgSets) = collect grp            val (bl, flgSets) = collect grp
371            fun chkCVars () = let            fun chkCVars () = let
372                  (* chkCVar checks the flags of a flag set.  If they are all false
373                   * then the corresponding cvar is set to signal the negative ack.
374                   *)
375                  fun chkCVar (cvar, flgs) = let                  fun chkCVar (cvar, flgs) = let
376                        fun chkFlgs [] = ()                        fun chkFlgs [] = atomicCVarSet cvar
377                          | chkFlgs ((ref true)::_) = atomicCVarSet cvar                          | chkFlgs ((ref true)::_) = ()
378                          | chkFlgs (_::r) = chkFlgs r                          | chkFlgs (_::r) = chkFlgs r
379                        in                        in
380                          chkFlgs flgs                          chkFlgs flgs

Legend:
Removed from v.843  
changed lines
  Added in v.844

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