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 448, Thu Oct 21 09:20:16 1999 UTC revision 449, Fri Oct 22 07:35:29 1999 UTC
# Line 1  Line 1 
1    (*
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  structure Servers :> SERVERS = struct  structure Servers :> SERVERS = struct
     type server = string * Unix.proc  
11    
12        type pathtrans = (string -> string) option
13        type server = string * Unix.proc * pathtrans
14    
15        val enabled = ref true
16      val nservers = ref 0      val nservers = ref 0
17      val all = ref ([]: server list)      val all = ref (StringMap.empty: server StringMap.map)
18    
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
23          | fname (n, SOME f) = if OS.Path.isAbsolute n then f n else n
24    
25      fun send (name, outs, s) =      fun send (name, outs, s) =
26          (Say.say ["-> ", name, ": ", s];          (Say.dsay ["-> ", name, ": ", s];
27           TextIO.output (outs, s);           TextIO.output (outs, s);
28           TextIO.flushOut outs)           TextIO.flushOut outs)
29    
30      fun show_idle () =      fun show_idle () =
31          Say.say ("Idle:" ::          Say.dsay ("Idle:" ::
32                   foldr (fn ((n, _), l) => " " :: n :: l) ["\n"] (!idle))                    foldr (fn ((n, _, _), l) => " " :: n :: l) ["\n"] (!idle))
33    
34      (* Mark a server idle; signal all those who are currently waiting for      (* Mark a server idle; signal all those who are currently waiting for
35       * that...*)       * that...*)
36      fun mark_idle (s as (name, _)) =      fun mark_idle (s as (name, _, _)) =
37          (idle := s :: !idle;          (idle := s :: !idle;
38           Concur.signal (!someIdle);           Concur.signal (!someIdle);
39           Say.say ["Scheduler: ", name, " has become idle.\n"];           Say.dsay ["Scheduler: slave ", name, " has become idle.\n"];
40           show_idle ())           show_idle ())
41    
42      (* Grab an idle server; wait if necessary; reinitialize condition      (* Grab an idle server; wait if necessary; reinitialize condition
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.say ["Scheduler: waiting for idle server.\n"];              [] => (Say.dsay ["Scheduler: waiting for idle slave.\n"];
47                     Concur.wait (!someIdle);                     Concur.wait (!someIdle);
48                     grab ())                     grab ())
49            | [only as (name, _)] =>            | [only as (name, _, _)] =>
50                  (Say.say ["Scheduler: taking last idle server (",                  (Say.dsay ["Scheduler: taking last idle slave (",
51                            name, ").\n"];                            name, ").\n"];
52                   idle := [];                   idle := [];
53                   someIdle := Concur.ucond ();                   someIdle := Concur.ucond ();
54                   only)                   only)
55            | (first as (name, _)) :: more =>            | (first as (name, _, _)) :: more =>
56                  (Say.say ["Scheduler: taking idle server (", name, ").\n"];                  (Say.dsay ["Scheduler: taking idle slave (", name, ").\n"];
57                     idle := more;
58                   show_idle ();                   show_idle ();
59                   idle := more; first)                   first)
60    
61      fun wait_status (name, p) = let      fun wait_status (name, p, tr) = let
62          val (ins, _) = Unix.streamsOf p          val (ins, _) = Unix.streamsOf p
63    
64          fun unexpected l = let          fun unexpected l = let
65              fun word (w, l) = " " :: w :: l              fun word (w, l) = " " :: w :: l
66          in          in
67              Say.say ("! Unexpected response from compile server " ::              Say.say ("! Unexpected response from slave " ::
68                       name :: ":" :: foldr word ["\n"] l)                       name :: ":" :: foldr word ["\n"] l)
69          end          end
70    
71          fun crashed () =          fun crashed () =
72              (Say.say ["! Compile server ", name, " has crashed\n"];              (Say.say ["! Slave ", name, " has crashed\n"];
73               Unix.reap p)               Unix.reap p)
74    
75          fun loop () =          fun loop () =
# Line 65  Line 81 
81                  in                  in
82                      if line = "" then (crashed (); false)                      if line = "" then (crashed (); false)
83                      else                      else
84                          (Say.say ["<- ", name, ": ", line];                          (Say.dsay ["<- ", name, ": ", line];
85                           case String.tokens Char.isSpace line of                           case String.tokens Char.isSpace line of
86                               ["SLAVE:", "ok"] =>                               ["SLAVE:", "ok"] =>
87                                   (mark_idle (name, p); true)                                   (mark_idle (name, p, tr); true)
88                             | ["SLAVE:", "error"] =>                             | ["SLAVE:", "error"] =>
89                                   (mark_idle (name, p); false)                                   (mark_idle (name, p, tr); false)
90                             | "SLAVE:" :: l => (unexpected l; loop ())                             | "SLAVE:" :: l => (unexpected l; loop ())
91                             | _ => loop ())                             | _ => loop ())
92                  end                  end
93    
94          and wait () = (Say.say ["Scheduler: ", name,          and wait () = (Say.dsay ["Scheduler: ", name,
95                                  " is waiting for server response.\n"];                                   " is waiting for slave response.\n"];
96                         Concur.wait (Concur.inputReady ins); loop ())                         Concur.wait (Concur.inputReady ins); loop ())
97      in      in
98          loop ()          loop ()
99      end      end
100    
101      fun add { name, cmd } = let      fun stop name = let
102            val (m, s) = StringMap.remove (!all, name)
103            val (_, p, _) = s
104            val (ins, outs) = Unix.streamsOf p
105        in
106            send (name, outs, "shutdown\n");
107            ignore (Unix.reap p);
108            all := m;
109            nservers := !nservers - 1
110        end handle LibBase.NotFound => ()
111    
112        fun kill name = let
113            val (m, s) = StringMap.remove (!all, name)
114            val (_, p, _) = s
115        in
116            Unix.kill (p, Posix.Signal.kill);
117            ignore (Unix.reap p);
118            all := m;
119            nservers := !nservers - 1
120        end handle LibBase.NotFound => ()
121    
122        fun start { name, cmd, pathtrans } = let
123            val _ = stop name
124          val p = Unix.execute cmd          val p = Unix.execute cmd
125          val s = (name, p)          val s = (name, p, pathtrans)
126      in      in
127          ignore (wait_status s);          if wait_status s then
128          all := s :: !all;              (all := StringMap.insert (!all, name, s);
129          nservers := 1 + !nservers               nservers := 1 + !nservers;
130                 true)
131            else false
132      end      end
133    
134      fun compile p =      fun compile p =
135          if !nservers = 0 then false          if not (!enabled) orelse !nservers = 0 then false
136          else let          else let
137              val f = SrcPath.osstring p              val f = SrcPath.osstring p
138              val s as (name, p) = grab ()              val s as (name, p, tr) = grab ()
139              val (_, outs) = Unix.streamsOf p              val (_, outs) = Unix.streamsOf p
140          in          in
141              Say.say ["(", name, "): compiling ", f, "\n"];              Say.vsay ["(", name, "): compiling ", f, "\n"];
142              send (name, outs, concat ["compile ", f, "\n"]);              send (name, outs, concat ["compile ", fname (f, tr), "\n"]);
143              wait_status s              wait_status s
144          end          end
145    
146      fun waitforall () = let      fun waitforall () = let
147          fun busy (name, p) =          fun busy (name, p, _) =
148              not (List.exists (fn (n', _) => name = n') (!idle))              not (List.exists (fn (n', _, _) => name = n') (!idle))
149          val b = List.filter busy (!all)          val b = List.filter busy (StringMap.listItems (!all))
150          fun w s = ignore (wait_status s)          fun w s = ignore (wait_status s)
151      in      in
152          app w b          app w b
153      end      end
154    
155      fun start (c, p) = let      fun cm p = let
156          val d = OS.FileSys.getDir ()          val d = OS.FileSys.getDir ()
157          val f = SrcPath.osstring p          val f = SrcPath.osstring p
158          fun st (s as (name, p)) = let          fun st (s as (name, p, tr)) = let
159              val (_, outs) = Unix.streamsOf p              val (_, outs) = Unix.streamsOf p
160          in          in
161              Say.say ["(", name, "): starting ", f, "\n"];              Say.vsay ["(", name, "): project ", f, "\n"];
162              send (name, outs, concat ["cm ", d, " ", f, "\n"]);              send (name, outs, concat ["cm ", fname (d, tr), " ",
163                                          fname (f, tr), "\n"]);
164              ignore (wait_status s)              ignore (wait_status s)
165          end          end
166          val _ = waitforall ()          val _ = waitforall ()
167          val l = !idle          val l = !idle
168          val _ = idle := []          val _ = idle := []
169            val tl = map (fn s => Concur.fork (fn () => st s)) l
170      in      in
171          app st l          app Concur.wait tl
172      end      end
173    
174        fun cmb db = let
175            val d = OS.FileSys.getDir ()
176            fun st (s as (name, p, tr)) = let
177                val (_, outs) = Unix.streamsOf p
178            in
179                Say.vsay ["(", name, "): bootstrap compile ", db, "\n"];
180                send (name, outs, concat ["cmb ", fname (d, tr), " ", db, "\n"]);
181                ignore (wait_status s)
182            end
183            val _ = waitforall ()
184            val l = !idle
185            val _ = idle := []
186            val tl = map (fn s => Concur.fork (fn () => st s)) l
187        in
188            app Concur.wait tl
189        end
190    
191        fun enable () = enabled := true
192        fun disable () = enabled := false
193  end  end

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

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