| 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 |
| 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 |
| 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 |
| 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 |
| 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 |
| 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 |
Parent Directory
| 
Revision Log
| 
Patch
