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 452, Mon Oct 25 08:33:25 1999 UTC revision 453, Tue Oct 26 06:24:34 1999 UTC
# Line 84  Line 84 
84              if echo then (fn report => Say.say (rev report))              if echo then (fn report => Say.say (rev report))
85              else (fn _ => ())              else (fn _ => ())
86    
87          fun loop report =          fun wouldBlock () =
88              case TextIO.canInput (ins, 1) of              case TextIO.canInput (ins, 1) of
89                  NONE => wait report                  NONE => true
90                | SOME 0 => wait report                | SOME 0 => true
91                | SOME _ => let                | SOME _ => false
92    
93            fun loop report =
94                if wouldBlock () then wait report
95                else let
96                      val line = TextIO.inputLine ins                      val line = TextIO.inputLine ins
97                  in                  in
98                      if line = "" then (crashed (); false)                      if line = "" then (crashed (); false)
# Line 116  Line 120 
120          loop []          loop []
121      end      end
122    
123        (* Send a "ping" to all servers and wait for the "pong" responses.
124         * This should work for all servers, busy or no.  Busy servers will
125         * take longer to respond because they first need to finish what
126         * they are doing.
127         * We use wait_all after we receive an interrupt signal.  The ping-pong
128         * protocol does not suffer from the race condition that we would have
129         * if we wanted to only wait for "ok"s from currently busy servers.
130         * (The race would happen when an interrupt occurs between receiving
131         * "ok" and marking the corresponding slave idle). *)
132        fun wait_all () = let
133            val al = StringMap.listItems (!all)
134            fun ping (s as ((name, p), _)) = let
135                val (ins, _) = Unix.streamsOf p
136                fun loop () = let
137                    val line = TextIO.inputLine ins
138                in
139                    case String.tokens Char.isSpace line of
140                        ["SLAVE:", "pong"] => ()
141                      | _ => loop ()
142                end
143            in
144                send (s, "ping\n");
145                loop ()
146            end
147        in
148            app ping al;
149            idle := al
150        end
151    
152      fun shutdown (name, method) = let      fun shutdown (name, method) = let
153          val (m, s) = StringMap.remove (!all, name)          val (m, s) = StringMap.remove (!all, name)
154          val ((_, p), _) = s          val ((_, p), _) = s
# Line 157  Line 190 
190              wait_status (s, true)              wait_status (s, true)
191          end          end
192    
193      fun reset () = let      fun reset () = (Concur.reset (); wait_all ())
         fun busy s =  
             not (List.exists (fn s' => servName s = servName s') (!idle))  
         val b = List.filter busy (StringMap.listItems (!all))  
         fun w s = ignore (wait_status (s, false))  
     in  
         Concur.reset ();  
         app w b  
     end  
194    
195      fun startAll st = let      fun startAll st = let
196          val _ = reset ()                (* redundant? *)          val _ = reset ()                (* redundant? *)
# Line 205  Line 230 
230          SafeIO.perform { openIt = enable,          SafeIO.perform { openIt = enable,
231                           closeIt = disable,                           closeIt = disable,
232                           work = f,                           work = f,
233                           cleanup = fn () => () }                           cleanup = reset }
234  end  end

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

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