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 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

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