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

Parent Directory | Revision Log | Patch

	revision 449, Fri Oct 22 07:35:29 1999 UTC	revision 450, Fri Oct 22 17:10:09 1999 UTC
#	Line 12	Line 12
12	type pathtrans = (string -> string) option	type pathtrans = (string -> string) option
13	type server = string * Unix.proc * pathtrans	type server = string * Unix.proc * pathtrans
14
15	val enabled = ref true	val enabled = ref false
16	val nservers = ref 0	val nservers = ref 0
17	val all = ref (StringMap.empty: server StringMap.map)	val all = ref (StringMap.empty: server StringMap.map)
18
#	Line 43	Line 43
43	* if taking the only server. *)	* if taking the only server. *)
44	fun grab () =	fun grab () =
45	case !idle of	case !idle of
46	[] => (Say.dsay ["Scheduler: waiting for idle slave.\n"];	[] => (Concur.wait (!someIdle); grab ())
	Concur.wait (!someIdle);
	grab ())
47	| [only as (name, _, _)] =>	| [only as (name, _, _)] =>
48	(Say.dsay ["Scheduler: taking last idle slave (",	(Say.dsay ["Scheduler: taking last idle slave (",
49	name, ").\n"];	name, ").\n"];
#	Line 58	Line 56
56	show_idle ();	show_idle ();
57	first)	first)
58
59	fun wait_status (name, p, tr) = let	fun wait_status ((name, p, tr), echo) = let
60	val (ins, _) = Unix.streamsOf p	val (ins, _) = Unix.streamsOf p
61
62	fun unexpected l = let	fun unexpected l = let
#	Line 72	Line 70
70	(Say.say ["! Slave ", name, " has crashed\n"];	(Say.say ["! Slave ", name, " has crashed\n"];
71	Unix.reap p)	Unix.reap p)
72
73	fun loop () =	val show =
74		if echo then (fn report => Say.say (rev report))
75		else (fn _ => ())
76
77		fun loop report =
78	case TextIO.canInput (ins, 1) of	case TextIO.canInput (ins, 1) of
79	NONE => wait ()	NONE => wait report
80	| SOME 0 => wait ()	| SOME 0 => wait report
81	| SOME _ => let	| SOME _ => let
82	val line = TextIO.inputLine ins	val line = TextIO.inputLine ins
83	in	in
#	Line 84	Line 86
86	(Say.dsay ["<- ", name, ": ", line];	(Say.dsay ["<- ", name, ": ", line];
87	case String.tokens Char.isSpace line of	case String.tokens Char.isSpace line of
88	["SLAVE:", "ok"] =>	["SLAVE:", "ok"] =>
89	(mark_idle (name, p, tr); true)	(mark_idle (name, p, tr);
90		show report;
91		true)
92	| ["SLAVE:", "error"] =>	| ["SLAVE:", "error"] =>
93	(mark_idle (name, p, tr); false)	(mark_idle (name, p, tr);
94	| "SLAVE:" :: l => (unexpected l; loop ())	(* In the case of error we don't show
95	| _ => loop ())	* the report because it will be re-enacted
96		* locally. *)
97		false)
98		| "SLAVE:" :: l => (unexpected l;
99		loop report)
100		| _ => loop (line :: report))
101	end	end
102
103	and wait () = (Say.dsay ["Scheduler: ", name,	and wait report = (Say.dsay ["Scheduler: ", name,
104	" is waiting for slave response.\n"];	" is waiting for slave response.\n"];
105	Concur.wait (Concur.inputReady ins); loop ())	Concur.wait (Concur.inputReady ins);
106		loop report)
107	in	in
108	loop ()	loop []
109	end	end
110
111	fun stop name = let	fun stop name = let
#	Line 124	Line 134
134	val p = Unix.execute cmd	val p = Unix.execute cmd
135	val s = (name, p, pathtrans)	val s = (name, p, pathtrans)
136	in	in
137	if wait_status s then	if wait_status (s, false) then
138	(all := StringMap.insert (!all, name, s);	(all := StringMap.insert (!all, name, s);
139	nservers := 1 + !nservers;	nservers := 1 + !nservers;
140	true)	true)
#	Line 140	Line 150
150	in	in
151	Say.vsay ["(", name, "): compiling ", f, "\n"];	Say.vsay ["(", name, "): compiling ", f, "\n"];
152	send (name, outs, concat ["compile ", fname (f, tr), "\n"]);	send (name, outs, concat ["compile ", fname (f, tr), "\n"]);
153	wait_status s	wait_status (s, true)
154	end	end
155
156	fun waitforall () = let	fun waitforall () = let
157	fun busy (name, p, _) =	fun busy (name, p, _) =
158	not (List.exists (fn (n', _, _) => name = n') (!idle))	not (List.exists (fn (n', _, _) => name = n') (!idle))
159	val b = List.filter busy (StringMap.listItems (!all))	val b = List.filter busy (StringMap.listItems (!all))
160	fun w s = ignore (wait_status s)	fun w s = ignore (wait_status (s, false))
161	in	in
162	app w b	app w b
163	end	end
#	Line 161	Line 171
171	Say.vsay ["(", name, "): project ", f, "\n"];	Say.vsay ["(", name, "): project ", f, "\n"];
172	send (name, outs, concat ["cm ", fname (d, tr), " ",	send (name, outs, concat ["cm ", fname (d, tr), " ",
173	fname (f, tr), "\n"]);	fname (f, tr), "\n"]);
174	ignore (wait_status s)	ignore (wait_status (s, false))
175	end	end
176	val _ = waitforall ()	val _ = waitforall ()
177	val l = !idle	val l = !idle
#	Line 178	Line 188
188	in	in
189	Say.vsay ["(", name, "): bootstrap compile ", db, "\n"];	Say.vsay ["(", name, "): bootstrap compile ", db, "\n"];
190	send (name, outs, concat ["cmb ", fname (d, tr), " ", db, "\n"]);	send (name, outs, concat ["cmb ", fname (d, tr), " ", db, "\n"]);
191	ignore (wait_status s)	ignore (wait_status (s, false))
192	end	end
193	val _ = waitforall ()	val _ = waitforall ()
194	val l = !idle	val l = !idle
#	Line 190	Line 200
200
201	fun enable () = enabled := true	fun enable () = enabled := true
202	fun disable () = enabled := false	fun disable () = enabled := false
203
204		fun withServers f =
205		SafeIO.perform { openIt = enable,
206		closeIt = disable,
207		work = f,
208		cleanup = fn () => () }
209	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.449   changed lines   Added in v.450

---

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