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

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