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 453, Tue Oct 26 06:24:34 1999 UTC revision 454, Wed Oct 27 04:41:14 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      datatype server = S of { name: string,
14                                 proc: Unix.proc,
15                                 pt: pathtrans,
16                                 pref: int }
17    
18      val enabled = ref false      val enabled = ref false
19      val nservers = ref 0      val nservers = ref 0
# Line 19  Line 22 
22      val idle = ref ([]: server list)      val idle = ref ([]: server list)
23      val someIdle = ref (Concur.ucond ())      val someIdle = ref (Concur.ucond ())
24    
25      fun fname (n, (_, NONE)) = n      fun fname (n, S { pt = NONE, ... }) = n
26        | fname (n, (_, SOME f)) = if OS.Path.isAbsolute n then f n else n        | fname (n, S { pt = SOME f, ... }) =
27            if OS.Path.isAbsolute n then f n else n
28    
29      fun servName ((n, _), _) = n      fun servName (S { name, ... }) = name
30    
31      fun send (s, msg) = let      fun send (s, msg) = let
32          val ((name, p), _) = s          val S { name, proc = p, ... } = s
33          val (_, outs) = Unix.streamsOf p          val (_, outs) = Unix.streamsOf p
34          fun send0 m =          fun send0 m =
35              (Say.dsay ["-> ", name, " : ", m];              (Say.dsay ["-> ", name, " : ", m];
# Line 58  Line 62 
62                   idle := [];                   idle := [];
63                   someIdle := Concur.ucond ();                   someIdle := Concur.ucond ();
64                   only)                   only)
65            | first :: more =>            | first :: more => let
66                  (Say.dsay ["Scheduler: taking idle slave (",                  fun best (b, [], rest) = (b, rest)
67                             servName first, ").\n"];                    | best (b, s :: r, rest) = let
68                   idle := more;                          val S { pref = bp, ... } = b
69                            val S { pref = sp, ... } = s
70                        in
71                            if sp > bp then best (s, r, b :: rest)
72                            else best (b, r, s :: rest)
73                        end
74                    val (b, rest) = best (first, more, [])
75                in
76                    Say.dsay ["Scheduler: taking idle slave (",
77                              servName b, ").\n"];
78                    idle := rest;
79                   show_idle ();                   show_idle ();
80                   first)                  b
81                end
82    
83      fun wait_status (s, echo) = let      fun wait_status (s, echo) = let
84          val ((name, p), _) = s          val S { name, proc = p, ... } = s
85          val (ins, _) = Unix.streamsOf p          val (ins, _) = Unix.streamsOf p
86    
87          fun unexpected l = let          fun unexpected l = let
# Line 131  Line 146 
146       * "ok" and marking the corresponding slave idle). *)       * "ok" and marking the corresponding slave idle). *)
147      fun wait_all () = let      fun wait_all () = let
148          val al = StringMap.listItems (!all)          val al = StringMap.listItems (!all)
149          fun ping (s as ((name, p), _)) = let          fun ping (s as S { name, proc = p, ... }) = let
150              val (ins, _) = Unix.streamsOf p              val (ins, _) = Unix.streamsOf p
151              fun loop () = let              fun loop () = let
152                  val line = TextIO.inputLine ins                  val line = TextIO.inputLine ins
# Line 151  Line 166 
166    
167      fun shutdown (name, method) = let      fun shutdown (name, method) = let
168          val (m, s) = StringMap.remove (!all, name)          val (m, s) = StringMap.remove (!all, name)
169          val ((_, p), _) = s          val S { proc = p, ... } = s
170          val (_, il) = List.partition (fn ((n, _), _) => name = n) (!idle)          val (_, il) = List.partition (fn s => name = servName s) (!idle)
171      in      in
172          method s;          method s;
173          ignore (Unix.reap p);          ignore (Unix.reap p);
# Line 165  Line 180 
180          shutdown (name, fn s => send (s, "shutdown\n"))          shutdown (name, fn s => send (s, "shutdown\n"))
181    
182      fun kill name =      fun kill name =
183          shutdown (name, fn ((_, p), _) => Unix.kill (p, Posix.Signal.kill))          shutdown (name, fn (S { proc = p, ... }) =>
184                               Unix.kill (p, Posix.Signal.kill))
185    
186      fun start { name, cmd, pathtrans } = let      fun start { name, cmd, pathtrans, pref } = let
187          val _ = stop name          val _ = stop name
188          val p = Unix.execute cmd          val p = Unix.execute cmd
189          val s : server = ((name, p), pathtrans)          val s = S { name = name, proc = p, pt = pathtrans, pref = pref }
190      in      in
191          if wait_status (s, false) then          if wait_status (s, false) then
192              (all := StringMap.insert (!all, name, s);              (all := StringMap.insert (!all, name, s);

Legend:
Removed from v.453  
changed lines
  Added in v.454

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