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 651, Thu Jun 1 18:34:03 2000 UTC revision 805, Thu Mar 22 20:08:01 2001 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 43  Line 49 
49          val all = ref (IntMap.empty: server IntMap.map)          val all = ref (IntMap.empty: server IntMap.map)
50          fun nservers () = IntMap.numItems (!all)          fun nservers () = IntMap.numItems (!all)
51      in      in
52            fun serverOf (h: server_handle) = IntMap.find (!all, #1 h)
53          fun allIdle () = length (!idle) = nservers ()          fun allIdle () = length (!idle) = nservers ()
54          fun noServers () = nservers () = 0          fun noServers () = nservers () = 0
55          fun allServers () = IntMap.listItems (!all)          fun allServers () = IntMap.listItems (!all)
# Line 53  Line 60 
60          end          end
61          fun delServer s =          fun delServer s =
62              (all := #1 (IntMap.remove (!all, servId s));              (all := #1 (IntMap.remove (!all, servId s));
63               (* If this was the last server we need to wake up               (* If this was the last server, then we need to wake up
64                * everyone who is currently waiting to grab a server.                * everyone who is currently waiting to grab a server.
65                * The "grab"-loop will then gracefully fail and                * The "grab"-loop will then gracefully fail and
66                * not cause a deadlock. *)                * not cause a deadlock. *)
# Line 63  Line 70 
70               else ())               else ())
71      end      end
72    
73      (* This really shouldn't be here, but putting it into SrcPath would      (* translate absolute pathname encoding; relative and anchored paths
74       * create a dependency cycle.  Some better structuring will fix this. *)       * stay unchanged *)
     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... *)      (* protect some code segment from sigPIPE signals... *)
81      fun pprotect work = let      fun pprotect work = let
# Line 311  Line 314 
314          startAll st          startAll st
315      end      end
316    
317      fun cmb { archos, root } = let      fun cmb { dirbase, archos, root } = let
318          fun st s =          fun st s =
319              (send (s, concat ["cmb ", archos, " ", root, "\n"]);              (send (s, concat ["cmb ", dirbase, " ", archos, " ", root, "\n"]);
320               ignore (wait_status (s, false)))               ignore (wait_status (s, false)))
321      in      in
322          startAll st          startAll st
323      end      end
324    
325      fun cmb_new { archos } = let      fun cmb_reset { archos } = let
326          fun st s =          fun st s =
327              (send (s, concat ["cmb ", archos, "\n"]);              (send (s, concat ["cmb_reset ", archos, "\n"]);
              ignore (wait_status (s, false)))  
     in  
         startAll st  
     end  
   
     fun dirbase db = let  
         fun st s =  
             (send (s, concat ["dirbase ", db, "\n"]);  
328               ignore (wait_status (s, false)))               ignore (wait_status (s, false)))
329      in      in
330          startAll st          startAll st
# Line 344  Line 339 
339                           work = f,                           work = f,
340                           cleanup = reset }                           cleanup = reset }
341    
342      val name = servName      fun name ((i, n) : server_handle) = n
343    
344        fun handleFun f h =
345            case serverOf h of
346                NONE => ()
347              | SOME s => f s
348    
349        val stop = handleFun stop
350        val kill = handleFun kill
351        val start = Option.map handleOf o start
352    
353        val _ = SrcPath.addClientToBeNotified cd
354  end  end

Legend:
Removed from v.651  
changed lines
  Added in v.805

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