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

SCM Repository

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

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

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 450, Fri Oct 22 17:10:09 1999 UTC revision 451, Sat Oct 23 15:05:55 1999 UTC
# Line 10  Line 10 
10  structure Servers :> SERVERS = struct  structure Servers :> SERVERS = struct
11    
12      type pathtrans = (string -> string) option      type pathtrans = (string -> string) option
13      type server = string * Unix.proc * pathtrans      type server = (string * Unix.proc * string list ref) * pathtrans
14    
15      val enabled = ref false      val enabled = ref false
16      val nservers = ref 0      val nservers = ref 0
# Line 19  Line 19 
19      val idle = ref ([]: server list)      val idle = ref ([]: server list)
20      val someIdle = ref (Concur.ucond ())      val someIdle = ref (Concur.ucond ())
21    
22      fun fname (n, NONE) = n      fun fname (n, (_, NONE)) = n
23        | fname (n, SOME f) = if OS.Path.isAbsolute n then f n else n        | fname (n, (_, SOME f)) = if OS.Path.isAbsolute n then f n else n
24    
25      fun send (name, outs, s) =      fun servName ((n, _, _), _) = n
26          (Say.dsay ["-> ", name, ": ", s];  
27           TextIO.output (outs, s);      fun send (s, msg) = let
28           TextIO.flushOut outs)          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      fun show_idle () =      fun show_idle () =
42          Say.dsay ("Idle:" ::          Say.dsay ("Idle:" ::
43                    foldr (fn ((n, _, _), l) => " " :: n :: l) ["\n"] (!idle))                    foldr (fn (s, l) => " " :: servName s :: l) ["\n"] (!idle))
44    
45      (* Mark a server idle; signal all those who are currently waiting for      (* Mark a server idle; signal all those who are currently waiting for
46       * that...*)       * that...*)
47      fun mark_idle (s as (name, _, _)) =      fun mark_idle s =
48          (idle := s :: !idle;          (idle := s :: !idle;
49           Concur.signal (!someIdle);           Concur.signal (!someIdle);
50           Say.dsay ["Scheduler: slave ", name, " has become idle.\n"];           Say.dsay ["Scheduler: slave ", servName s, " has become idle.\n"];
51           show_idle ())           show_idle ())
52    
53      (* Grab an idle server; wait if necessary; reinitialize condition      (* Grab an idle server; wait if necessary; reinitialize condition
# Line 44  Line 55 
55      fun grab () =      fun grab () =
56          case !idle of          case !idle of
57              [] => (Concur.wait (!someIdle); grab ())              [] => (Concur.wait (!someIdle); grab ())
58            | [only as (name, _, _)] =>            | [only] =>
59                  (Say.dsay ["Scheduler: taking last idle slave (",                  (Say.dsay ["Scheduler: taking last idle slave (",
60                             name, ").\n"];                             servName only, ").\n"];
61                   idle := [];                   idle := [];
62                   someIdle := Concur.ucond ();                   someIdle := Concur.ucond ();
63                   only)                   only)
64            | (first as (name, _, _)) :: more =>            | first :: more =>
65                  (Say.dsay ["Scheduler: taking idle slave (", name, ").\n"];                  (Say.dsay ["Scheduler: taking idle slave (",
66                               servName first, ").\n"];
67                   idle := more;                   idle := more;
68                   show_idle ();                   show_idle ();
69                   first)                   first)
70    
71      fun wait_status ((name, p, tr), echo) = let      fun wait_status (s, echo) = let
72            val ((name, p, _), _) = s
73          val (ins, _) = Unix.streamsOf p          val (ins, _) = Unix.streamsOf p
74    
75          fun unexpected l = let          fun unexpected l = let
# Line 86  Line 99 
99                          (Say.dsay ["<- ", name, ": ", line];                          (Say.dsay ["<- ", name, ": ", line];
100                           case String.tokens Char.isSpace line of                           case String.tokens Char.isSpace line of
101                               ["SLAVE:", "ok"] =>                               ["SLAVE:", "ok"] =>
102                                   (mark_idle (name, p, tr);                                   (mark_idle s; show report; true)
                                   show report;  
                                   true)  
103                             | ["SLAVE:", "error"] =>                             | ["SLAVE:", "error"] =>
104                                   (mark_idle (name, p, tr);                                   (mark_idle s;
105                                    (* In the case of error we don't show                                    (* In the case of error we don't show
106                                     * the report because it will be re-enacted                                     * the report because it will be re-enacted
107                                     * locally. *)                                     * locally. *)
# Line 110  Line 121 
121    
122      fun stop name = let      fun stop name = let
123          val (m, s) = StringMap.remove (!all, name)          val (m, s) = StringMap.remove (!all, name)
124          val (_, p, _) = s          val ((_, p, _), _) = s
         val (ins, outs) = Unix.streamsOf p  
125      in      in
126          send (name, outs, "shutdown\n");          send (s, "shutdown\n");
127          ignore (Unix.reap p);          ignore (Unix.reap p);
128          all := m;          all := m;
129          nservers := !nservers - 1          nservers := !nservers - 1
# Line 121  Line 131 
131    
132      fun kill name = let      fun kill name = let
133          val (m, s) = StringMap.remove (!all, name)          val (m, s) = StringMap.remove (!all, name)
134          val (_, p, _) = s          val ((_, p, _), _) = s
135      in      in
136          Unix.kill (p, Posix.Signal.kill);          Unix.kill (p, Posix.Signal.kill);
137          ignore (Unix.reap p);          ignore (Unix.reap p);
# Line 132  Line 142 
142      fun start { name, cmd, pathtrans } = let      fun start { name, cmd, pathtrans } = let
143          val _ = stop name          val _ = stop name
144          val p = Unix.execute cmd          val p = Unix.execute cmd
145          val s = (name, p, pathtrans)          val s : server = ((name, p, ref []), pathtrans)
146      in      in
147          if wait_status (s, false) then          if wait_status (s, false) then
148              (all := StringMap.insert (!all, name, s);              (all := StringMap.insert (!all, name, s);
# Line 145  Line 155 
155          if not (!enabled) orelse !nservers = 0 then false          if not (!enabled) orelse !nservers = 0 then false
156          else let          else let
157              val f = SrcPath.osstring p              val f = SrcPath.osstring p
158              val s as (name, p, tr) = grab ()              val s = grab ()
             val (_, outs) = Unix.streamsOf p  
159          in          in
160              Say.vsay ["(", name, "): compiling ", f, "\n"];              Say.vsay ["(", servName s, "): compiling ", f, "\n"];
161              send (name, outs, concat ["compile ", fname (f, tr), "\n"]);              send (s, concat ["compile ", fname (f, s), "\n"]);
162              wait_status (s, true)              wait_status (s, true)
163          end          end
164    
165      fun waitforall () = let      fun reset () = let
166          fun busy (name, p, _) =          fun busy s =
167              not (List.exists (fn (n', _, _) => name = n') (!idle))              not (List.exists (fn s' => servName s = servName s') (!idle))
168          val b = List.filter busy (StringMap.listItems (!all))          val b = List.filter busy (StringMap.listItems (!all))
169          fun w s = ignore (wait_status (s, false))          fun w s = ignore (wait_status (s, false))
170      in      in
171            Concur.reset ();
172          app w b          app w b
173      end      end
174    
175      fun cm p = let      fun cm p = let
176          val d = OS.FileSys.getDir ()          val d = OS.FileSys.getDir ()
177          val f = SrcPath.osstring p          val f = SrcPath.osstring p
178          fun st (s as (name, p, tr)) = let          fun st s =
179              val (_, outs) = Unix.streamsOf p              (Say.vsay ["(", servName s, "): project ", f, "\n"];
180          in               send (s, concat ["cm ", fname (d, s), " ", fname (f, s), "\n"]);
181              Say.vsay ["(", name, "): project ", f, "\n"];               ignore (wait_status (s, false)))
             send (name, outs, concat ["cm ", fname (d, tr), " ",  
                                       fname (f, tr), "\n"]);  
             ignore (wait_status (s, false))  
         end  
         val _ = waitforall ()  
182          val l = !idle          val l = !idle
183          val _ = idle := []          val _ = idle := []
184          val tl = map (fn s => Concur.fork (fn () => st s)) l          val tl = map (fn s => Concur.fork (fn () => st s)) l
# Line 183  Line 188 
188    
189      fun cmb db = let      fun cmb db = let
190          val d = OS.FileSys.getDir ()          val d = OS.FileSys.getDir ()
191          fun st (s as (name, p, tr)) = let          fun st s =
192              val (_, outs) = Unix.streamsOf p              (Say.vsay ["(", servName s, "): bootstrap compile ", db, "\n"];
193          in               send (s, concat ["cmb ", fname (d, s), " ", db, "\n"]);
194              Say.vsay ["(", name, "): bootstrap compile ", db, "\n"];               ignore (wait_status (s, false)))
             send (name, outs, concat ["cmb ", fname (d, tr), " ", db, "\n"]);  
             ignore (wait_status (s, false))  
         end  
         val _ = waitforall ()  
195          val l = !idle          val l = !idle
196          val _ = idle := []          val _ = idle := []
197          val tl = map (fn s => Concur.fork (fn () => st s)) l          val tl = map (fn s => Concur.fork (fn () => st s)) l
# Line 198  Line 199 
199          app Concur.wait tl          app Concur.wait tl
200      end      end
201    
202        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      fun enable () = enabled := true      fun enable () = enabled := true
211      fun disable () = enabled := false      fun disable () = enabled := false
212    

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

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