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 484, Thu Nov 18 08:46:16 1999 UTC revision 735, Tue Nov 21 12:15:55 2000 UTC
# Line 7  Line 7 
7   *   *
8   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
9   *)   *)
10  structure Servers :> SERVERS = struct  
11    (* It is unfortunate but necessary to use a transparant match here.
12     * Otherwise the "hack" in $smlnj/cm/full.cm won't work. *)
13    structure Servers : SERVERS = struct
14    
15      structure P = Posix      structure P = Posix
16    
# Line 19  Line 22 
22                               pref: int,                               pref: int,
23                               decommissioned: bool ref }                               decommissioned: bool ref }
24    
25        type server_handle = int * string   (* id and name *)
26    
27        fun handleOf (S { id, name, ... }) = (id, name)
28      fun servId (S { id, ... }) = id      fun servId (S { id, ... }) = id
29      fun decommission (S { decommissioned, ... }) = decommissioned := true      fun decommission (S { decommissioned, ... }) = decommissioned := true
30      fun decommissioned (S { decommissioned = d, ... }) = !d      fun decommissioned (S { decommissioned = d, ... }) = !d
# Line 36  Line 42 
42      end      end
43      val enabled = ref false      val enabled = ref false
44    
45        val idle = ref ([]: server list)
46        val someIdle = ref (Concur.pcond ())
47    
48      local      local
49          val nservers = ref 0          val all = ref (IntMap.empty: server IntMap.map)
50          val all = ref (IntRedBlackMap.empty: server IntRedBlackMap.map)          fun nservers () = IntMap.numItems (!all)
51      in      in
52          fun noServers () = !nservers = 0          fun serverOf (h: server_handle) = IntMap.find (!all, #1 h)
53          fun allServers () = IntRedBlackMap.listItems (!all)          fun allIdle () = length (!idle) = nservers ()
54            fun noServers () = nservers () = 0
55            fun allServers () = IntMap.listItems (!all)
56          fun addServer s = let          fun addServer s = let
57              val ns = !nservers              val ns = nservers ()
58          in          in
59              nservers := ns + 1;              all := IntMap.insert (!all, servId s, s)
             all := IntRedBlackMap.insert (!all, servId s, s)  
         end  
         fun delServer s = let  
             val ns = !nservers - 1  
         in  
             all := #1 (IntRedBlackMap.remove (!all, servId s));  
             nservers := ns  
60          end          end
61            fun delServer s =
62                (all := #1 (IntMap.remove (!all, servId s));
63                 (* If this was the last server, then we need to wake up
64                  * everyone who is currently waiting to grab a server.
65                  * The "grab"-loop will then gracefully fail and
66                  * not cause a deadlock. *)
67                 if noServers () then
68                     (Say.dsay ["No more servers -> back to sequential mode.\n"];
69                      Concur.signal (!someIdle))
70                 else ())
71      end      end
72    
73      val idle = ref ([]: server list)      (* translate absolute pathname encoding; relative and anchored paths
74      val someIdle = ref (Concur.pcond ())       * stay unchanged *)
   
     (* This really shouldn't be here, but putting it into SrcPath would  
      * create a dependency cycle.  Some better structuring will fix this. *)  
     fun isAbsoluteDescr d =  
         (case String.sub (d, 0) of #"/" => true | #"%" => true | _ => false)  
         handle _ => false  
   
75      fun fname (n, s) =      fun fname (n, s) =
76          case servPT s of          case servPT s of
77              NONE => n              NONE => n
78            | SOME f => if isAbsoluteDescr n then f n else n            | SOME f => if SrcPath.encodingIsAbsolute n then f n else n
79    
80        (* protect some code segment from sigPIPE signals... *)
81      fun pprotect work = let      fun pprotect work = let
82          val pipe = UnixSignals.sigPIPE          val pipe = UnixSignals.sigPIPE
83          fun disable () = Signals.setHandler (pipe, Signals.IGNORE)          fun disable () = Signals.setHandler (pipe, Signals.IGNORE)
# Line 79  Line 87 
87                           work = fn _ => work (), cleanup = fn _ => () }                           work = fn _ => work (), cleanup = fn _ => () }
88      end      end
89    
90        (* Send a message to a slave. This must be sigPIPE-protected. *)
91      fun send (s, msg) = let      fun send (s, msg) = let
92          val outs = servOuts s          val outs = servOuts s
93      in      in
# Line 103  Line 112 
112      (* Grab an idle server; wait if necessary; reinitialize condition      (* Grab an idle server; wait if necessary; reinitialize condition
113       * if taking the only server. *)       * if taking the only server. *)
114      fun grab () =      fun grab () =
115          case !idle of          (* We need to check the following every time (at least the
116             * "noServers" part) because it might be that all servers
117             * have meanwhile gone away for some reason (crashed, etc.). *)
118            if not (!enabled) orelse noServers () then NONE
119            else case !idle of
120              [] => (Concur.wait (!someIdle); grab ())              [] => (Concur.wait (!someIdle); grab ())
121            | [only] =>            | [only] =>
122                  (Say.dsay ["Scheduler: taking last idle slave (",                  (Say.dsay ["Scheduler: taking last idle slave (",
123                             servName only, ").\n"];                             servName only, ").\n"];
124                   idle := [];                   idle := [];
125                   someIdle := Concur.pcond ();                   someIdle := Concur.pcond ();
126                   only)                   SOME only)
127            | first :: more => let            | first :: more => let
128                  fun best (b, [], rest) = (b, rest)                  fun best (b, [], rest) = (b, rest)
129                    | best (b, s :: r, rest) = let                    | best (b, s :: r, rest) = let
# Line 126  Line 139 
139                            servName b, ").\n"];                            servName b, ").\n"];
140                  idle := rest;                  idle := rest;
141                  show_idle ();                  show_idle ();
142                  b                  SOME b
143              end              end
144    
145      fun wait_status (s, echo) = let      fun wait_status (s, echo) = let
# Line 148  Line 161 
161                    | _ => "crashed"                    | _ => "crashed"
162          in          in
163              decommission s;              decommission s;
164              Say.say ["! Slave ", name, " has ", what, ".\n"];              Say.say ["[!Slave ", name, " has ", what, ".]\n"];
165              delServer s              delServer s
166          end          end
167    
# Line 256  Line 269 
269      end      end
270    
271      fun compile p =      fun compile p =
272          if not (!enabled) orelse noServers () then false          case grab () of
273          else let              NONE => false
274              val s = grab ()            | SOME s => let
275              val f = fname (p, s)              val f = fname (p, s)
276          in          in
277              Say.vsay ["[(", servName s, "): compiling ", f, "]\n"];              Say.vsay ["[(", servName s, "): compiling ", f, "]\n"];
# Line 309  Line 322 
322          startAll st          startAll st
323      end      end
324    
325        fun cmb_new { archos } = let
326            fun st s =
327                (send (s, concat ["cmb ", archos, "\n"]);
328                 ignore (wait_status (s, false)))
329        in
330            startAll st
331        end
332    
333      fun dirbase db = let      fun dirbase db = let
334          fun st s =          fun st s =
335              (send (s, concat ["dirbase ", db, "\n"]);              (send (s, concat ["dirbase ", db, "\n"]);
# Line 326  Line 347 
347                           work = f,                           work = f,
348                           cleanup = reset }                           cleanup = reset }
349    
350      val name = servName      fun name ((i, n) : server_handle) = n
351    
352        fun handleFun f h =
353            case serverOf h of
354                NONE => ()
355              | SOME s => f s
356    
357        val stop = handleFun stop
358        val kill = handleFun kill
359        val start = Option.map handleOf o start
360    
361        val _ = SrcPath.addClientToBeNotified cd
362  end  end

Legend:
Removed from v.484  
changed lines
  Added in v.735

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