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 461, Thu Nov 4 08:06:56 1999 UTC revision 464, Tue Nov 9 06:49:52 1999 UTC
# Line 31  Line 31 
31        structure DG = DependencyGraph        structure DG = DependencyGraph
32    
33        val os = SMLofNJ.SysInfo.getOSKind ()        val os = SMLofNJ.SysInfo.getOSKind ()
34          val my_archos =
35              concat [HostMachDepVC.architecture, "-", FilenamePolicy.kind2name os]
36    
37        structure SSV =        structure SSV =
38            SpecificSymValFn (structure MachDepVC = HostMachDepVC            SpecificSymValFn (structure MachDepVC = HostMachDepVC
# Line 41  Line 43 
43    
44        structure Compile =        structure Compile =
45            CompileFn (structure MachDepVC = HostMachDepVC            CompileFn (structure MachDepVC = HostMachDepVC
46                       val compile_there = Servers.compile)                       val compile_there = Servers.compile o SrcPath.descr)
47    
48        structure Link =        structure Link =
49            LinkFn (structure MachDepVC = HostMachDepVC            LinkFn (structure MachDepVC = HostMachDepVC
# Line 56  Line 58 
58             structure BFC = BFC)             structure BFC = BFC)
59    
60        fun init_servers (GroupGraph.GROUP { grouppath, ... }) =        fun init_servers (GroupGraph.GROUP { grouppath, ... }) =
61            Servers.cm grouppath            Servers.cm { archos = my_archos, project = SrcPath.descr grouppath }
62    
63        fun recomp_runner gp g = let        fun recomp_runner gp g = let
64            val _ = init_servers g            val _ = init_servers g
# Line 243  Line 245 
245                fun say_error () = Say.say ["SLAVE: error\n"]                fun say_error () = Say.say ["SLAVE: error\n"]
246                fun say_pong () = Say.say ["SLAVE: pong\n"]                fun say_pong () = Say.say ["SLAVE: pong\n"]
247    
               val touch = HostMachDepVC.Interact.useStream o TextIO.openString  
   
248                val home =                val home =
249                    case OS.Process.getEnv "HOME" of                    case OS.Process.getEnv "HOME" of
250                        SOME h => (fn d => OS.Path.mkAbsolute { path = d,                        SOME h => (fn d => OS.Path.mkAbsolute { path = d,
# Line 253  Line 253 
253                                 (Say.say ["HOME not set!\n"];                                 (Say.say ["HOME not set!\n"];
254                                  raise Fail "HOME not set"))                                  raise Fail "HOME not set"))
255    
               fun chDir d0 =  
                   OS.FileSys.chDir (if OS.Path.isAbsolute d0 then d0  
                                     else home d0)  
   
256                fun path (s, pcmode) = SrcPath.fromDescr pcmode s                fun path (s, pcmode) = SrcPath.fromDescr pcmode s
257    
258                  fun chDir d =
259                      (OS.FileSys.chDir (SrcPath.osstring (path (d, pcmode)));
260                       Say.say ["New dir: ", OS.FileSys.getDir (), "\n"])
261    
262                fun waitForStart () = let                fun waitForStart () = let
263                    val line = TextIO.inputLine TextIO.stdIn                    val line = TextIO.inputLine TextIO.stdIn
264                in                in
265                    if line = "" then shutdown ()                    if line = "" then shutdown ()
266                    else case String.tokens Char.isSpace line of                    else case String.tokens Char.isSpace line of
267                        ["cm", d, f] => do_cm (d, f)                        ["cd", d] => (chDir d; say_ok (); waitForStart ())
268                      | ["cmb", archos, d, f] => do_cmb (archos, d, f)                      | ["cm", archos, f] => do_cm (archos, f)
269                        | ["cmb", archos, f] => do_cmb (archos, f)
270                      | ["ping"] => (say_pong (); waitForStart ())                      | ["ping"] => (say_pong (); waitForStart ())
271                      | ["finish"] => (say_ok (); waitForStart ())                      | ["finish"] => (say_ok (); waitForStart ())
272                      | ["dirbase", db] =>                      | ["dirbase", db] =>
# Line 274  Line 275 
275                      | _ => (say_error (); waitForStart ())                      | _ => (say_error (); waitForStart ())
276                end handle _ => (say_error (); waitForStart ())                end handle _ => (say_error (); waitForStart ())
277    
278                and do_cmb (archos, d, f) = let                and do_cmb (archos, f) = let
279                    val _ = chDir d                    val slave = CMBSlave.slave make
                   val slave = CMBSlave.slave { load = autoload, touch = touch }  
280                in                in
281                    case slave archos (!dbr, f) of                    case slave archos (!dbr, f) of
282                        NONE => (say_error (); waitForStart ())                        NONE => (say_error (); waitForStart ())
# Line 288  Line 288 
288                        end                        end
289                end handle _ => (say_error (); waitForStart ())                end handle _ => (say_error (); waitForStart ())
290    
291                and do_cm (d, f) = let                and do_cm (archos, f) =
292                    val _ = chDir d                    if archos <> my_archos then (say_error (); waitForStart ())
293                      else let
294                    val p = path (f, pcmode)                    val p = path (f, pcmode)
295                in                in
296                    case Parse.parse NONE (param ()) NONE p of                    case Parse.parse NONE (param ()) NONE p of
# Line 310  Line 311 
311                    in                    in
312                        if line = "" then shutdown ()                        if line = "" then shutdown ()
313                        else case String.tokens Char.isSpace line of                        else case String.tokens Char.isSpace line of
314                            ["compile", f] => let                            ["cd", d] => (chDir d; say_ok (); loop ())
315                            | ["compile", f] => let
316                                val p = path (f, pcmode)                                val p = path (f, pcmode)
317                            in                            in
318                                case SrcPathMap.find (index, p) of                                case SrcPathMap.find (index, p) of
# Line 322  Line 324 
324                                        else (say_error (); loop ())                                        else (say_error (); loop ())
325                                    end                                    end
326                            end                            end
327                          | ["cm", d, f] => do_cm (d, f)                          | ["cm", archos, f] => do_cm (archos, f)
328                          | ["cmb", archos, d, f] => do_cmb (archos, d, f)                          | ["cmb", archos, f] => do_cmb (archos, f)
329                          | ["finish"] => (say_ok (); waitForStart ())                          | ["finish"] => (say_ok (); waitForStart ())
330                          | ["dirbase", db] =>                          | ["dirbase", db] =>
331                                (say_ok (); dbr := db; waitForStart ())                                (say_ok (); dbr := db; waitForStart ())
# Line 484  Line 486 
486                                     listLibs = listLibs,                                     listLibs = listLibs,
487                                     dismissLib = dismissLib,                                     dismissLib = dismissLib,
488                                     symval = SSV.symval,                                     symval = SSV.symval,
489                                     server_start = Servers.start,                                     server_start =
490                                         fn x => (Servers.start x
491                                                  before SrcPath.invalidateCwd ()),
492                                     server_stop = Servers.stop,                                     server_stop = Servers.stop,
493                                     server_kill = Servers.kill })                                     server_kill = Servers.kill })
494    

Legend:
Removed from v.461  
changed lines
  Added in v.464

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