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/main/cm-boot.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/main/cm-boot.sml

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

revision 453, Tue Oct 26 06:24:34 1999 UTC revision 456, Wed Oct 27 15:09:58 1999 UTC
# Line 55  Line 55 
55             structure L = Link             structure L = Link
56             structure BFC = BFC)             structure BFC = BFC)
57    
58          fun init_servers (GroupGraph.GROUP { grouppath, ... }) =
59              Servers.cm grouppath
60    
61        fun recomp_runner gp g = let        fun recomp_runner gp g = let
62              val _ = init_servers g
63            fun store _ = ()            fun store _ = ()
64            val { group, ... } = Compile.newTraversal (Link.evict, store, g)            val { group, ... } = Compile.newTraversal (Link.evict, store, g)
65        in        in
# Line 68  Line 72 
72         * environment) and adds it to the toplevel environment. *)         * environment) and adds it to the toplevel environment. *)
73        fun make_runner gp g = let        fun make_runner gp g = let
74            val { store, get } = BFC.new ()            val { store, get } = BFC.new ()
75              val _ = init_servers g
76            val { group = c_group, ... } =            val { group = c_group, ... } =
77                Compile.newTraversal (Link.evict, store, g)                Compile.newTraversal (Link.evict, store, g)
78            val { group = l_group, ... } = Link.newTraversal (g, get)            val { group = l_group, ... } = Link.newTraversal (g, get)
# Line 105  Line 110 
110        structure Stabilize =        structure Stabilize =
111            StabilizeFn (structure MachDepVC = HostMachDepVC            StabilizeFn (structure MachDepVC = HostMachDepVC
112                         fun recomp gp g = let                         fun recomp gp g = let
                            val GroupGraph.GROUP { grouppath, ... } = g  
113                             val { store, get } = BFC.new ()                             val { store, get } = BFC.new ()
114                               val _ = init_servers g
115                             val { group, ... } =                             val { group, ... } =
116                                 Compile.newTraversal (Link.evict, store, g)                                 Compile.newTraversal (Link.evict, store, g)
117                         in                         in
# Line 210  Line 215 
215                val c = SrcPath.cwdContext ()                val c = SrcPath.cwdContext ()
216                val p = SrcPath.standard pcmode { context = c, spec = s }                val p = SrcPath.standard pcmode { context = c, spec = s }
217            in            in
               Servers.cm p;  
218                case Parse.parse NONE (param ()) sflag p of                case Parse.parse NONE (param ()) sflag p of
219                    NONE => false                    NONE => false
220                  | SOME (g, gp) =>                  | SOME (g, gp) => f gp g
                       SafeIO.perform { openIt = fn () => (),  
                                        closeIt = Servers.reset,  
                                        work = fn () => f gp g,  
                                        cleanup = fn () => () }  
221            end            end
222    
223            val listLibs = Parse.listLibs            val listLibs = Parse.listLibs
# Line 235  Line 235 
235            val make = run NONE make_runner            val make = run NONE make_runner
236    
237            fun slave () = let            fun slave () = let
238    
239                  val dbr = ref BtNames.dirbaseDefault
240    
241                fun shutdown () = OS.Process.exit OS.Process.success                fun shutdown () = OS.Process.exit OS.Process.success
242                fun say_ok () = Say.say ["SLAVE: ok\n"]                fun say_ok () = Say.say ["SLAVE: ok\n"]
243                fun say_error () = Say.say ["SLAVE: error\n"]                fun say_error () = Say.say ["SLAVE: error\n"]
# Line 248  Line 251 
251                    if line = "" then shutdown ()                    if line = "" then shutdown ()
252                    else case String.tokens Char.isSpace line of                    else case String.tokens Char.isSpace line of
253                        ["cm", d, f] => do_cm (d, f)                        ["cm", d, f] => do_cm (d, f)
254                      | ["cmb", archos, d, db] => do_cmb (archos, d, db)                      | ["cmb", archos, d, f] => do_cmb (archos, d, f)
255                      | ["ping"] => (say_pong (); waitForStart ())                      | ["ping"] => (say_pong (); waitForStart ())
256                      | ["finish"] => (say_ok (); waitForStart ())                      | ["finish"] => (say_ok (); waitForStart ())
257                        | ["dirbase", db] =>
258                              (say_ok (); dbr := db; waitForStart ())
259                      | ["shutdown"] => shutdown ()                      | ["shutdown"] => shutdown ()
260                      | _ => (say_error (); waitForStart ())                      | _ => (say_error (); waitForStart ())
261                end handle _ => (say_error (); waitForStart ())                end handle _ => (say_error (); waitForStart ())
262    
263                and do_cmb (archos, d, db) = let                and do_cmb (archos, d, f) = let
264                    val _ = OS.FileSys.chDir d                    val _ = OS.FileSys.chDir d
265                    val c = SrcPath.cwdContext ()                    val c = SrcPath.cwdContext ()
266                    val slave = CMBSlave.slave { load = autoload, touch = touch }                    val slave = CMBSlave.slave { load = autoload, touch = touch }
267                in                in
268                    case slave archos db of                    case slave archos (!dbr, f) of
269                        NONE => (say_error (); waitForStart ())                        NONE => (say_error (); waitForStart ())
270                      | SOME (g, trav) => let                      | SOME (g, trav) => let
271                            val _ = say_ok ()                            val _ = say_ok ()
# Line 307  Line 312 
312                                    in                                    in
313                                        if trav sbn then (say_ok (); loop ())                                        if trav sbn then (say_ok (); loop ())
314                                        else (say_error (); loop ())                                        else (say_error (); loop ())
315                                    end handle _ => (say_error (); loop ())                                    end
316                            end                            end
317                          | ["cm", d, f] => do_cm (d, f)                          | ["cm", d, f] => do_cm (d, f)
318                          | ["cmb", archos, d, db] => do_cmb (archos, d, db)                          | ["cmb", archos, d, f] => do_cmb (archos, d, f)
319                          | ["finish"] => (say_ok (); waitForStart ())                          | ["finish"] => (say_ok (); waitForStart ())
320                            | ["dirbase", db] =>
321                                  (say_ok (); dbr := db; waitForStart ())
322                          | ["ping"] => (say_pong (); loop ())                          | ["ping"] => (say_pong (); loop ())
323                          | ["shutdown"] => shutdown ()                          | ["shutdown"] => shutdown ()
324                          | _ => (say_error (); loop ())                          | _ => (say_error (); loop ())

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

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