Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/cm/compile/unix-servers.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 451 - (view) (download)

1 : blume 449 (*
2 :     * Handling compile-servers under Unix- (and Unix-like) operating systems.
3 :     *
4 :     * This is still rather crude and not very robust.
5 :     *
6 :     * (C) 1999 Lucent Technologies, Bell Laboratories
7 :     *
8 :     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
9 :     *)
10 : blume 448 structure Servers :> SERVERS = struct
11 :    
12 : blume 449 type pathtrans = (string -> string) option
13 : blume 451 type server = (string * Unix.proc * string list ref) * pathtrans
14 : blume 449
15 : blume 450 val enabled = ref false
16 : blume 448 val nservers = ref 0
17 : blume 449 val all = ref (StringMap.empty: server StringMap.map)
18 : blume 448
19 :     val idle = ref ([]: server list)
20 :     val someIdle = ref (Concur.ucond ())
21 :    
22 : blume 451 fun fname (n, (_, NONE)) = n
23 :     | fname (n, (_, SOME f)) = if OS.Path.isAbsolute n then f n else n
24 : blume 449
25 : blume 451 fun servName ((n, _, _), _) = n
26 : blume 448
27 : blume 451 fun send (s, msg) = let
28 :     val ((name, p, r as ref el), _) = s
29 :     val (_, outs) = Unix.streamsOf p
30 :     fun send0 m =
31 :     (Say.dsay ["-> ", name, " : ", m];
32 :     TextIO.output (outs, m))
33 :     fun ev x = send0 (concat ["evict ", x, "\n"])
34 :     in
35 :     app ev el;
36 :     r := [];
37 :     send0 msg;
38 :     TextIO.flushOut outs
39 :     end
40 :    
41 : blume 448 fun show_idle () =
42 : blume 449 Say.dsay ("Idle:" ::
43 : blume 451 foldr (fn (s, l) => " " :: servName s :: l) ["\n"] (!idle))
44 : blume 448
45 :     (* Mark a server idle; signal all those who are currently waiting for
46 :     * that...*)
47 : blume 451 fun mark_idle s =
48 : blume 448 (idle := s :: !idle;
49 :     Concur.signal (!someIdle);
50 : blume 451 Say.dsay ["Scheduler: slave ", servName s, " has become idle.\n"];
51 : blume 448 show_idle ())
52 :    
53 :     (* Grab an idle server; wait if necessary; reinitialize condition
54 :     * if taking the only server. *)
55 :     fun grab () =
56 :     case !idle of
57 : blume 450 [] => (Concur.wait (!someIdle); grab ())
58 : blume 451 | [only] =>
59 : blume 449 (Say.dsay ["Scheduler: taking last idle slave (",
60 : blume 451 servName only, ").\n"];
61 : blume 448 idle := [];
62 :     someIdle := Concur.ucond ();
63 :     only)
64 : blume 451 | first :: more =>
65 :     (Say.dsay ["Scheduler: taking idle slave (",
66 :     servName first, ").\n"];
67 : blume 449 idle := more;
68 : blume 448 show_idle ();
69 : blume 449 first)
70 : blume 448
71 : blume 451 fun wait_status (s, echo) = let
72 :     val ((name, p, _), _) = s
73 : blume 448 val (ins, _) = Unix.streamsOf p
74 :    
75 :     fun unexpected l = let
76 :     fun word (w, l) = " " :: w :: l
77 :     in
78 : blume 449 Say.say ("! Unexpected response from slave " ::
79 : blume 448 name :: ":" :: foldr word ["\n"] l)
80 :     end
81 :    
82 :     fun crashed () =
83 : blume 449 (Say.say ["! Slave ", name, " has crashed\n"];
84 : blume 448 Unix.reap p)
85 :    
86 : blume 450 val show =
87 :     if echo then (fn report => Say.say (rev report))
88 :     else (fn _ => ())
89 :    
90 :     fun loop report =
91 : blume 448 case TextIO.canInput (ins, 1) of
92 : blume 450 NONE => wait report
93 :     | SOME 0 => wait report
94 : blume 448 | SOME _ => let
95 :     val line = TextIO.inputLine ins
96 :     in
97 :     if line = "" then (crashed (); false)
98 :     else
99 : blume 449 (Say.dsay ["<- ", name, ": ", line];
100 : blume 448 case String.tokens Char.isSpace line of
101 :     ["SLAVE:", "ok"] =>
102 : blume 451 (mark_idle s; show report; true)
103 : blume 448 | ["SLAVE:", "error"] =>
104 : blume 451 (mark_idle s;
105 : blume 450 (* In the case of error we don't show
106 :     * the report because it will be re-enacted
107 :     * locally. *)
108 :     false)
109 :     | "SLAVE:" :: l => (unexpected l;
110 :     loop report)
111 :     | _ => loop (line :: report))
112 : blume 448 end
113 :    
114 : blume 450 and wait report = (Say.dsay ["Scheduler: ", name,
115 :     " is waiting for slave response.\n"];
116 :     Concur.wait (Concur.inputReady ins);
117 :     loop report)
118 : blume 448 in
119 : blume 450 loop []
120 : blume 448 end
121 :    
122 : blume 449 fun stop name = let
123 :     val (m, s) = StringMap.remove (!all, name)
124 : blume 451 val ((_, p, _), _) = s
125 : blume 449 in
126 : blume 451 send (s, "shutdown\n");
127 : blume 449 ignore (Unix.reap p);
128 :     all := m;
129 :     nservers := !nservers - 1
130 :     end handle LibBase.NotFound => ()
131 :    
132 :     fun kill name = let
133 :     val (m, s) = StringMap.remove (!all, name)
134 : blume 451 val ((_, p, _), _) = s
135 : blume 449 in
136 :     Unix.kill (p, Posix.Signal.kill);
137 :     ignore (Unix.reap p);
138 :     all := m;
139 :     nservers := !nservers - 1
140 :     end handle LibBase.NotFound => ()
141 :    
142 :     fun start { name, cmd, pathtrans } = let
143 :     val _ = stop name
144 : blume 448 val p = Unix.execute cmd
145 : blume 451 val s : server = ((name, p, ref []), pathtrans)
146 : blume 448 in
147 : blume 450 if wait_status (s, false) then
148 : blume 449 (all := StringMap.insert (!all, name, s);
149 :     nservers := 1 + !nservers;
150 :     true)
151 :     else false
152 : blume 448 end
153 : blume 449
154 : blume 448 fun compile p =
155 : blume 449 if not (!enabled) orelse !nservers = 0 then false
156 : blume 448 else let
157 :     val f = SrcPath.osstring p
158 : blume 451 val s = grab ()
159 : blume 448 in
160 : blume 451 Say.vsay ["(", servName s, "): compiling ", f, "\n"];
161 :     send (s, concat ["compile ", fname (f, s), "\n"]);
162 : blume 450 wait_status (s, true)
163 : blume 448 end
164 :    
165 : blume 451 fun reset () = let
166 :     fun busy s =
167 :     not (List.exists (fn s' => servName s = servName s') (!idle))
168 : blume 449 val b = List.filter busy (StringMap.listItems (!all))
169 : blume 450 fun w s = ignore (wait_status (s, false))
170 : blume 448 in
171 : blume 451 Concur.reset ();
172 : blume 448 app w b
173 :     end
174 :    
175 : blume 449 fun cm p = let
176 : blume 448 val d = OS.FileSys.getDir ()
177 :     val f = SrcPath.osstring p
178 : blume 451 fun st s =
179 :     (Say.vsay ["(", servName s, "): project ", f, "\n"];
180 :     send (s, concat ["cm ", fname (d, s), " ", fname (f, s), "\n"]);
181 :     ignore (wait_status (s, false)))
182 : blume 448 val l = !idle
183 :     val _ = idle := []
184 : blume 449 val tl = map (fn s => Concur.fork (fn () => st s)) l
185 : blume 448 in
186 : blume 449 app Concur.wait tl
187 : blume 448 end
188 : blume 449
189 :     fun cmb db = let
190 :     val d = OS.FileSys.getDir ()
191 : blume 451 fun st s =
192 :     (Say.vsay ["(", servName s, "): bootstrap compile ", db, "\n"];
193 :     send (s, concat ["cmb ", fname (d, s), " ", db, "\n"]);
194 :     ignore (wait_status (s, false)))
195 : blume 449 val l = !idle
196 :     val _ = idle := []
197 :     val tl = map (fn s => Concur.fork (fn () => st s)) l
198 :     in
199 :     app Concur.wait tl
200 :     end
201 :    
202 : blume 451 fun evict i = let
203 :     val p = SmlInfo.sourcepath i
204 :     val f = SrcPath.osstring p
205 :     fun ev (s as ((_, _, r), _)) = r := fname (f, s) :: !r
206 :     in
207 :     StringMap.app ev (!all)
208 :     end
209 :    
210 : blume 449 fun enable () = enabled := true
211 :     fun disable () = enabled := false
212 : blume 450
213 :     fun withServers f =
214 :     SafeIO.perform { openIt = enable,
215 :     closeIt = disable,
216 :     work = f,
217 :     cleanup = fn () => () }
218 : blume 448 end

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