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 449, Fri Oct 22 07:35:29 1999 UTC revision 456, Wed Oct 27 15:09:58 1999 UTC
# Line 28  Line 28 
28        structure BF = HostMachDepVC.Binfile        structure BF = HostMachDepVC.Binfile
29        structure P = OS.Path        structure P = OS.Path
30        structure F = OS.FileSys        structure F = OS.FileSys
31          structure DG = DependencyGraph
32    
33        val os = SMLofNJ.SysInfo.getOSKind ()        val os = SMLofNJ.SysInfo.getOSKind ()
34    
# Line 54  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
66            isSome (group gp) before Link.cleanup gp            isSome (Servers.withServers (fn () => group gp))
67              before Link.cleanup gp
68        end        end
69    
70        (* This function combines the actions of "recompile" and "exec".        (* This function combines the actions of "recompile" and "exec".
# Line 66  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)
79            val GroupGraph.GROUP { required = rq, ... } = g            val GroupGraph.GROUP { required = rq, ... } = g
80        in        in
81            case c_group gp of            case Servers.withServers (fn () => c_group gp) of
82                NONE => false                NONE => false
83              | SOME { stat, sym} =>              | SOME { stat, sym} =>
84                    (* Before executing the code, we announce the priviliges                    (* Before executing the code, we announce the priviliges
# Line 104  Line 111 
111            StabilizeFn (structure MachDepVC = HostMachDepVC            StabilizeFn (structure MachDepVC = HostMachDepVC
112                         fun recomp gp g = let                         fun recomp gp g = let
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
118                             case group gp of                             case Servers.withServers (fn () => group gp) of
119                                 NONE => NONE                                 NONE => NONE
120                               | SOME _ => SOME get                               | SOME _ => SOME get
121                         end                         end
122                         fun destroy_state gp i =                         fun destroy_state gp i =
123                             (Compile.evict i; Link.evict gp i)                             (Compile.evict i;
124                                Link.evict gp i)
125                         val getII = Compile.getII)                         val getII = Compile.getII)
126    
127        (* Access to the stabilization mechanism is integrated into the        (* Access to the stabilization mechanism is integrated into the
# Line 208  Line 217 
217            in            in
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
                       (Servers.cm p;  
                        f gp g  
                        before Servers.waitforall ())  
221            end            end
222    
223            val listLibs = Parse.listLibs            val listLibs = Parse.listLibs
# Line 229  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"]
244                  fun say_pong () = Say.say ["SLAVE: pong\n"]
245    
246                  val touch = HostMachDepVC.Interact.useStream o TextIO.openString
247    
248                fun waitForStart () = let                fun waitForStart () = let
249                    val line = TextIO.inputLine TextIO.stdIn                    val line = TextIO.inputLine TextIO.stdIn
# Line 239  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", d, db] => do_cmb (d, db)                      | ["cmb", archos, d, f] => do_cmb (archos, d, f)
255                        | ["ping"] => (say_pong (); waitForStart ())
256                        | ["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 (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 }
267                in                in
268                    case CMBSlave.slave make db of                    case slave archos (!dbr, f) of
269                        NONE => (say_error (); waitForStart ())                        NONE => (say_error (); waitForStart ())
270                      | SOME (g, gp, trav) => let                      | SOME (g, trav) => let
271                            val _ = say_ok ()                            val _ = say_ok ()
272                            val index = Reachable.snodeMap g                            val index = Reachable.snodeMap g
273                        in                        in
274                            workLoop (index, trav, gp, c)                            workLoop (index, trav, c)
275                        end                        end
276                end handle _ => (say_error (); waitForStart ())                end handle _ => (say_error (); waitForStart ())
277    
# Line 271  Line 288 
288                            val trav = Compile.newSbnodeTraversal () gp                            val trav = Compile.newSbnodeTraversal () gp
289                            fun trav' sbn = isSome (trav sbn)                            fun trav' sbn = isSome (trav sbn)
290                        in                        in
291                            workLoop (index, trav', gp, c)                            workLoop (index, trav', c)
292                        end                        end
293                end handle _ => (say_error (); waitForStart ())                end handle _ => (say_error (); waitForStart ())
294    
295                and workLoop (index, trav, gp, c) = let                and workLoop (index, trav, c) = let
296                      fun f2sn f =
297                          SrcPathMap.find (index,
298                                           SrcPath.native { context = c,
299                                                            spec = f })
300                    fun loop () = let                    fun loop () = let
301                        val line = TextIO.inputLine TextIO.stdIn                        val line = TextIO.inputLine TextIO.stdIn
302                    in                    in
# Line 287  Line 308 
308                                case SrcPathMap.find (index, p) of                                case SrcPathMap.find (index, p) of
309                                    NONE => (say_error (); loop ())                                    NONE => (say_error (); loop ())
310                                  | SOME sn => let                                  | SOME sn => let
311                                        val sbn = DependencyGraph.SB_SNODE sn                                        val sbn = DG.SB_SNODE sn
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                                    end
316                            end                            end
317                          | ["cm", d, f] => do_cm (d, f)                          | ["cm", d, f] => do_cm (d, f)
318                            | ["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 ())
323                          | ["shutdown"] => shutdown ()                          | ["shutdown"] => shutdown ()
324                          | _ => (say_error (); loop ())                          | _ => (say_error (); loop ())
325                    end handle _ => (say_error (); loop ())                    end handle _ => (say_error (); loop ())
# Line 302  Line 327 
327                    loop ()                    loop ()
328                end                end
329            in            in
330                  ignore (Signals.setHandler (Signals.sigINT, Signals.IGNORE));
331                say_ok ();                (* announce readiness *)                say_ok ();                (* announce readiness *)
332                waitForStart ()                waitForStart () handle _ => ();
333                  OS.Process.exit OS.Process.failure
334            end            end
335    
336            fun reset () =            fun reset () =
# Line 472  Line 499 
499                            (getOpt (OS.Path.ext f, "<none>")))                            (getOpt (OS.Path.ext f, "<none>")))
500      in      in
501          case SMLofNJ.getArgs () of          case SMLofNJ.getArgs () of
502              ["@CMslave"] => slave ()              ["@CMslave"] => (#set StdConfig.verbose false; slave ())
503            | l => app (p o c) l            | l => app (p o c) l
504      end      end
505    end    end

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

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