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

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

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

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