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

Parent Directory | Revision Log | Patch

	revision 485, Thu Nov 18 08:54:14 1999 UTC	revision 486, Thu Nov 18 14:05:46 1999 UTC
#	Line 36	Line 36
36	end	end
37	val enabled = ref false	val enabled = ref false
38
39		val idle = ref ([]: server list)
40		val someIdle = ref (Concur.pcond ())
41
42	local	local
43	val nservers = ref 0	val nservers = ref 0
44	val all = ref (IntMap.empty: server IntMap.map)	val all = ref (IntMap.empty: server IntMap.map)
#	Line 52	Line 55
55	val ns = !nservers - 1	val ns = !nservers - 1
56	in	in
57	all := #1 (IntMap.remove (!all, servId s));	all := #1 (IntMap.remove (!all, servId s));
58	nservers := ns	nservers := ns;
59		(* If this was the last server we need to wake up
60		* everyone who is currently waiting to grab a server.
61		* The "grab"-loop will then gracefully fail and
62		* not cause a deadlock. *)
63		if ns = 0 then
64		(Say.dsay ["No more servers -> back to sequential mode.\n"];
65		Concur.signal (!someIdle))
66		else ()
67	end	end
68	end	end
69
	val idle = ref ([]: server list)
	val someIdle = ref (Concur.pcond ())
70	(* This really shouldn't be here, but putting it into SrcPath would	(* This really shouldn't be here, but putting it into SrcPath would
71	* create a dependency cycle.  Some better structuring will fix this. *)	* create a dependency cycle.  Some better structuring will fix this. *)
72	fun isAbsoluteDescr d =	fun isAbsoluteDescr d =
#	Line 70	Line 78
78	NONE => n	NONE => n
79	| SOME f => if isAbsoluteDescr n then f n else n	| SOME f => if isAbsoluteDescr n then f n else n
80
81		(* protect some code segment from sigPIPE signals... *)
82	fun pprotect work = let	fun pprotect work = let
83	val pipe = UnixSignals.sigPIPE	val pipe = UnixSignals.sigPIPE
84	fun disable () = Signals.setHandler (pipe, Signals.IGNORE)	fun disable () = Signals.setHandler (pipe, Signals.IGNORE)
#	Line 79	Line 88
88	work = fn _ => work (), cleanup = fn _ => () }	work = fn _ => work (), cleanup = fn _ => () }
89	end	end
90
91		(* Send a message to a slave. This must be sigPIPE-protected. *)
92	fun send (s, msg) = let	fun send (s, msg) = let
93	val outs = servOuts s	val outs = servOuts s
94	in	in
#	Line 103	Line 113
113	(* Grab an idle server; wait if necessary; reinitialize condition	(* Grab an idle server; wait if necessary; reinitialize condition
114	* if taking the only server. *)	* if taking the only server. *)
115	fun grab () =	fun grab () =
116	case !idle of	(* We need to check the following every time (at least the
117		* "noServers" part) because it might be that all servers
118		* have meanwhile gone away for some reason (crashed, etc.). *)
119		if not (!enabled) orelse noServers () then NONE
120		else case !idle of
121	[] => (Concur.wait (!someIdle); grab ())	[] => (Concur.wait (!someIdle); grab ())
122	| [only] =>	| [only] =>
123	(Say.dsay ["Scheduler: taking last idle slave (",	(Say.dsay ["Scheduler: taking last idle slave (",
124	servName only, ").\n"];	servName only, ").\n"];
125	idle := [];	idle := [];
126	someIdle := Concur.pcond ();	someIdle := Concur.pcond ();
127	only)	SOME only)
128	| first :: more => let	| first :: more => let
129	fun best (b, [], rest) = (b, rest)	fun best (b, [], rest) = (b, rest)
130	| best (b, s :: r, rest) = let	| best (b, s :: r, rest) = let
#	Line 126	Line 140
140	servName b, ").\n"];	servName b, ").\n"];
141	idle := rest;	idle := rest;
142	show_idle ();	show_idle ();
143	b	SOME b
144	end	end
145
146	fun wait_status (s, echo) = let	fun wait_status (s, echo) = let
#	Line 148	Line 162
162	| _ => "crashed"	| _ => "crashed"
163	in	in
164	decommission s;	decommission s;
165	Say.say ["! Slave ", name, " has ", what, ".\n"];	Say.say ["[!Slave ", name, " has ", what, ".]\n"];
166	delServer s	delServer s
167	end	end
168
#	Line 256	Line 270
270	end	end
271
272	fun compile p =	fun compile p =
273	if not (!enabled) orelse noServers () then false	case grab () of
274	else let	NONE => false
275	val s = grab ()	| SOME s => let
276	val f = fname (p, s)	val f = fname (p, s)
277	in	in
278	Say.vsay ["[(", servName s, "): compiling ", f, "]\n"];	Say.vsay ["[(", servName s, "): compiling ", f, "]\n"];

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.485   changed lines   Added in v.486

---

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