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 451, Sat Oct 23 15:05:55 1999 UTC revision 452, Mon Oct 25 08:33:25 1999 UTC
# Line 116  Line 116 
116                         end                         end
117                         fun destroy_state gp i =                         fun destroy_state gp i =
118                             (Compile.evict i;                             (Compile.evict i;
                             Servers.evict i;  
119                              Link.evict gp i)                              Link.evict gp i)
120                         val getII = Compile.getII)                         val getII = Compile.getII)
121    
# Line 215  Line 214 
214                case Parse.parse NONE (param ()) sflag p of                case Parse.parse NONE (param ()) sflag p of
215                    NONE => false                    NONE => false
216                  | SOME (g, gp) =>                  | SOME (g, gp) =>
217                        (f gp g                        SafeIO.perform { openIt = fn () => (),
218                         before Servers.reset ())                                         closeIt = Servers.reset,
219                                           work = fn () => f gp g,
220                                           cleanup = fn () => () }
221            end            end
222    
223            val listLibs = Parse.listLibs            val listLibs = Parse.listLibs
# Line 238  Line 239 
239                fun say_ok () = Say.say ["SLAVE: ok\n"]                fun say_ok () = Say.say ["SLAVE: ok\n"]
240                fun say_error () = Say.say ["SLAVE: error\n"]                fun say_error () = Say.say ["SLAVE: error\n"]
241    
242                  val touch = HostMachDepVC.Interact.useStream o TextIO.openString
243    
244                fun waitForStart () = let                fun waitForStart () = let
245                    val line = TextIO.inputLine TextIO.stdIn                    val line = TextIO.inputLine TextIO.stdIn
246                in                in
247                    if line = "" then shutdown ()                    if line = "" then shutdown ()
248                    else case String.tokens Char.isSpace line of                    else case String.tokens Char.isSpace line of
249                        ["cm", d, f] => do_cm (d, f)                        ["cm", d, f] => do_cm (d, f)
250                      | ["cmb", d, db] => do_cmb (d, db)                      | ["cmb", archos, d, db] => do_cmb (archos, d, db)
251                      | ["shutdown"] => shutdown ()                      | ["shutdown"] => shutdown ()
252                      | _ => (say_error (); waitForStart ())                      | _ => (say_error (); waitForStart ())
253                end handle _ => (say_error (); waitForStart ())                end handle _ => (say_error (); waitForStart ())
254    
255                and do_cmb (d, db) = let                and do_cmb (archos, d, db) = let
256                    val _ = OS.FileSys.chDir d                    val _ = OS.FileSys.chDir d
257                    val c = SrcPath.cwdContext ()                    val c = SrcPath.cwdContext ()
258                      val slave = CMBSlave.slave { load = autoload, touch = touch }
259                in                in
260                    case CMBSlave.slave make db of                    case slave archos db of
261                        NONE => (say_error (); waitForStart ())                        NONE => (say_error (); waitForStart ())
262                      | SOME (g, trav, evict) => let                      | SOME (g, trav) => let
263                            val _ = say_ok ()                            val _ = say_ok ()
264                            val index = Reachable.snodeMap g                            val index = Reachable.snodeMap g
265                        in                        in
266                            workLoop (index, trav, evict, c)                            workLoop (index, trav, c)
267                        end                        end
268                end handle _ => (say_error (); waitForStart ())                end handle _ => (say_error (); waitForStart ())
269    
# Line 276  Line 280 
280                            val trav = Compile.newSbnodeTraversal () gp                            val trav = Compile.newSbnodeTraversal () gp
281                            fun trav' sbn = isSome (trav sbn)                            fun trav' sbn = isSome (trav sbn)
282                        in                        in
283                            workLoop (index, trav', Compile.evict, c)                            workLoop (index, trav', c)
284                        end                        end
285                end handle _ => (say_error (); waitForStart ())                end handle _ => (say_error (); waitForStart ())
286    
287                and workLoop (index, trav, evict, c) = let                and workLoop (index, trav, c) = let
288                    fun f2sn f =                    fun f2sn f =
289                        SrcPathMap.find (index,                        SrcPathMap.find (index,
290                                         SrcPath.native { context = c,                                         SrcPath.native { context = c,
# Line 290  Line 294 
294                    in                    in
295                        if line = "" then shutdown ()                        if line = "" then shutdown ()
296                        else case String.tokens Char.isSpace line of                        else case String.tokens Char.isSpace line of
297                            ["evict", f] =>                            ["compile", f] => let
                               (case f2sn f of  
                                    NONE => loop ()  
                                  | SOME (DG.SNODE { smlinfo, ... }) =>  
                                        (evict smlinfo; loop ()))  
                         | ["compile", f] => let  
298                                val p = SrcPath.native { context = c, spec = f }                                val p = SrcPath.native { context = c, spec = f }
299                            in                            in
300                                case SrcPathMap.find (index, p) of                                case SrcPathMap.find (index, p) of
# Line 305  Line 304 
304                                    in                                    in
305                                        if trav sbn then (say_ok (); loop ())                                        if trav sbn then (say_ok (); loop ())
306                                        else (say_error (); loop ())                                        else (say_error (); loop ())
307                                    end                                    end handle _ => (say_error (); loop ())
308                            end                            end
309                          | ["cm", d, f] => do_cm (d, f)                          | ["cm", d, f] => do_cm (d, f)
310                          | ["finish"] => (say_ok (); waitForStart ())                          | ["finish"] => (say_ok (); waitForStart ())
# Line 317  Line 316 
316                end                end
317            in            in
318                say_ok ();                (* announce readiness *)                say_ok ();                (* announce readiness *)
319                waitForStart ()                waitForStart () handle _ => ();
320                  OS.Process.exit OS.Process.failure
321            end            end
322    
323            fun reset () =            fun reset () =

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

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