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/concur/unix-servers.sml
ViewVC logotype

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

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

revision 478, Thu Nov 11 03:02:05 1999 UTC revision 479, Thu Nov 11 07:46:35 1999 UTC
# Line 22  Line 22 
22      val idle = ref ([]: server list)      val idle = ref ([]: server list)
23      val someIdle = ref (Concur.pcond ())      val someIdle = ref (Concur.pcond ())
24    
25      fun fname (n, S { pt = NONE, ... }) = n      (* This really shouldn't be here, but putting it into SrcPath would
26        | fname (n, S { pt = SOME f, ... }) =       * create a dependency cycle.  Some better structuring will fix this. *)
27          (if String.sub (n, 0) = #"/" then f n else n)      fun isAbsoluteDescr d =
28          handle _ => n          (case String.sub (d, 0) of #"/" => true | #"%" => true | _ => false)
29            handle _ => false
30    
31      fun servName (S { name, ... }) = name      fun servName (S { name, ... }) = name
32        fun servPref (S { pref, ... }) = pref
33        fun servPT (S { pt, ... }) = pt
34        fun servProc (S { proc, ... }) = proc
35        val servIns = #1 o Unix.streamsOf o servProc
36        val servOuts = #2 o Unix.streamsOf o servProc
37    
38        fun fname (n, s) =
39            case servPT s of
40                NONE => n
41              | SOME f => if isAbsoluteDescr n then f n else n
42    
43      fun send (s, msg) = let      fun send (s, msg) = let
44          val S { name, proc = p, ... } = s          val outs = servOuts s
         val (_, outs) = Unix.streamsOf p  
         fun send0 m =  
             (Say.dsay ["-> ", name, " : ", m];  
              TextIO.output (outs, m))  
45      in      in
46          send0 msg;          Say.dsay ["-> ", servName s, " : ", msg];
47            TextIO.output (outs, msg);
48          TextIO.flushOut outs          TextIO.flushOut outs
49      end      end
50    
# Line 66  Line 74 
74            | first :: more => let            | first :: more => let
75                  fun best (b, [], rest) = (b, rest)                  fun best (b, [], rest) = (b, rest)
76                    | best (b, s :: r, rest) = let                    | best (b, s :: r, rest) = let
77                          val S { pref = bp, ... } = b                          val bp = servPref b
78                          val S { pref = sp, ... } = s                          val sp = servPref s
79                      in                      in
80                          if sp > bp then best (s, r, b :: rest)                          if sp > bp then best (s, r, b :: rest)
81                          else best (b, r, s :: rest)                          else best (b, r, s :: rest)
# Line 82  Line 90 
90              end              end
91    
92      fun wait_status (s, echo) = let      fun wait_status (s, echo) = let
93          val S { name, proc = p, ... } = s          val name = servName s
94          val (ins, _) = Unix.streamsOf p          val ins = servIns s
95    
96          fun unexpected l = let          fun unexpected l = let
97              fun word (w, l) = " " :: w :: l              fun word (w, l) = " " :: w :: l
# Line 94  Line 102 
102    
103          fun crashed () =          fun crashed () =
104              (Say.say ["! Slave ", name, " has crashed\n"];              (Say.say ["! Slave ", name, " has crashed\n"];
105               Unix.reap p)               Unix.reap (servProc s))
106    
107          val show =          val show =
108              if echo then (fn report => Say.say (rev report))              if echo then (fn report => Say.say (rev report))
# Line 145  Line 153 
153       * "ok" and marking the corresponding slave idle). *)       * "ok" and marking the corresponding slave idle). *)
154      fun wait_all is_int = let      fun wait_all is_int = let
155          val al = StringMap.listItems (!all)          val al = StringMap.listItems (!all)
156          fun ping (s as S { name, proc = p, ... }) = let          fun ping s = let
157              val (ins, _) = Unix.streamsOf p              val name = servName s
158                val ins = servIns s
159              fun loop () = let              fun loop () = let
160                  val line = TextIO.inputLine ins                  val line = TextIO.inputLine ins
161              in              in
# Line 174  Line 183 
183    
184      fun shutdown (name, method) = let      fun shutdown (name, method) = let
185          val (m, s) = StringMap.remove (!all, name)          val (m, s) = StringMap.remove (!all, name)
186          val S { proc = p, ... } = s          val p = servProc s
187          val (_, il) = List.partition (fn s => name = servName s) (!idle)          val (_, il) = List.partition (fn s => name = servName s) (!idle)
188      in      in
189          method s;          method s;
# Line 184  Line 193 
193          idle := il          idle := il
194      end handle LibBase.NotFound => ()      end handle LibBase.NotFound => ()
195    
196      fun stop name =      fun stop_by_name name = shutdown (name, fn s => send (s, "shutdown\n"))
         shutdown (name, fn s => send (s, "shutdown\n"))  
197    
198      fun kill name =      fun stop s = stop_by_name (servName s)
199          shutdown (name, fn (S { proc = p, ... }) =>  
200                             Unix.kill (p, Posix.Signal.term))      fun kill s = shutdown (servName s,
201                               fn s => Unix.kill (servProc s, Posix.Signal.term))
202    
203      fun start { name, cmd, pathtrans, pref } = let      fun start { name, cmd, pathtrans, pref } = let
204          val _ = stop name          val _ = stop_by_name name
205          val p = Unix.execute cmd          val p = Unix.execute cmd
206          val s = S { name = name, proc = p, pt = pathtrans, pref = pref }          val s = S { name = name, proc = p, pt = pathtrans, pref = pref }
207      in      in
208          if wait_status (s, false) then          if wait_status (s, false) then
209              (all := StringMap.insert (!all, name, s);              (all := StringMap.insert (!all, name, s);
210               nservers := 1 + !nservers;               nservers := 1 + !nservers;
211               true)               SOME s)
212          else false          else NONE
213      end      end
214    
215      fun compile p =      fun compile p =
# Line 273  Line 282 
282                           closeIt = disable,                           closeIt = disable,
283                           work = f,                           work = f,
284                           cleanup = reset }                           cleanup = reset }
285    
286        val name = servName
287  end  end

Legend:
Removed from v.478  
changed lines
  Added in v.479

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