Diff of /sml/trunk/src/cm/compile/unix-servers.sml

Parent Directory | Revision Log | Patch

	revision 452, Mon Oct 25 08:33:25 1999 UTC	revision 453, Tue Oct 26 06:24:34 1999 UTC
#	Line 84	Line 84
84	if echo then (fn report => Say.say (rev report))	if echo then (fn report => Say.say (rev report))
85	else (fn _ => ())	else (fn _ => ())
86
87	fun loop report =	fun wouldBlock () =
88	case TextIO.canInput (ins, 1) of	case TextIO.canInput (ins, 1) of
89	NONE => wait report	NONE => true
90	| SOME 0 => wait report	| SOME 0 => true
91	| SOME _ => let	| SOME _ => false
92
93		fun loop report =
94		if wouldBlock () then wait report
95		else let
96	val line = TextIO.inputLine ins	val line = TextIO.inputLine ins
97	in	in
98	if line = "" then (crashed (); false)	if line = "" then (crashed (); false)
#	Line 116	Line 120
120	loop []	loop []
121	end	end
122
123		(* Send a "ping" to all servers and wait for the "pong" responses.
124		* This should work for all servers, busy or no.  Busy servers will
125		* take longer to respond because they first need to finish what
126		* they are doing.
127		* We use wait_all after we receive an interrupt signal.  The ping-pong
128		* protocol does not suffer from the race condition that we would have
129		* if we wanted to only wait for "ok"s from currently busy servers.
130		* (The race would happen when an interrupt occurs between receiving
131		* "ok" and marking the corresponding slave idle). *)
132		fun wait_all () = let
133		val al = StringMap.listItems (!all)
134		fun ping (s as ((name, p), _)) = let
135		val (ins, _) = Unix.streamsOf p
136		fun loop () = let
137		val line = TextIO.inputLine ins
138		in
139		case String.tokens Char.isSpace line of
140		["SLAVE:", "pong"] => ()
141		| _ => loop ()
142		end
143		in
144		send (s, "ping\n");
145		loop ()
146		end
147		in
148		app ping al;
149		idle := al
150		end
151
152	fun shutdown (name, method) = let	fun shutdown (name, method) = let
153	val (m, s) = StringMap.remove (!all, name)	val (m, s) = StringMap.remove (!all, name)
154	val ((_, p), _) = s	val ((_, p), _) = s
#	Line 157	Line 190
190	wait_status (s, true)	wait_status (s, true)
191	end	end
192
193	fun reset () = let	fun reset () = (Concur.reset (); wait_all ())
	fun busy s =
	not (List.exists (fn s' => servName s = servName s') (!idle))
	val b = List.filter busy (StringMap.listItems (!all))
	fun w s = ignore (wait_status (s, false))
	in
	Concur.reset ();
	app w b
	end
194
195	fun startAll st = let	fun startAll st = let
196	val _ = reset ()                (* redundant? *)	val _ = reset ()                (* redundant? *)
#	Line 205	Line 230
230	SafeIO.perform { openIt = enable,	SafeIO.perform { openIt = enable,
231	closeIt = disable,	closeIt = disable,
232	work = f,	work = f,
233	cleanup = fn () => () }	cleanup = reset }
234	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.452   changed lines   Added in v.453

---

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