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 433, Mon Sep 13 06:57:29 1999 UTC revision 451, Sat Oct 23 15:05:55 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 39  Line 40 
40        val system_values = ref emptydyn        val system_values = ref emptydyn
41    
42        structure Compile =        structure Compile =
43            CompileFn (structure MachDepVC = HostMachDepVC)            CompileFn (structure MachDepVC = HostMachDepVC
44                         val compile_there = Servers.compile)
45    
46        structure Link =        structure Link =
47            LinkFn (structure MachDepVC = HostMachDepVC            LinkFn (structure MachDepVC = HostMachDepVC
# Line 57  Line 59 
59            fun store _ = ()            fun store _ = ()
60            val { group, ... } = Compile.newTraversal (Link.evict, store, g)            val { group, ... } = Compile.newTraversal (Link.evict, store, g)
61        in        in
62            isSome (group gp) before Link.cleanup gp            isSome (Servers.withServers (fn () => group gp))
63              before Link.cleanup gp
64        end        end
65    
66        (* This function combines the actions of "recompile" and "exec".        (* This function combines the actions of "recompile" and "exec".
# Line 70  Line 73 
73            val { group = l_group, ... } = Link.newTraversal (g, get)            val { group = l_group, ... } = Link.newTraversal (g, get)
74            val GroupGraph.GROUP { required = rq, ... } = g            val GroupGraph.GROUP { required = rq, ... } = g
75        in        in
76            case c_group gp of            case Servers.withServers (fn () => c_group gp) of
77                NONE => false                NONE => false
78              | SOME { stat, sym} =>              | SOME { stat, sym} =>
79                    (* Before executing the code, we announce the priviliges                    (* Before executing the code, we announce the priviliges
# Line 102  Line 105 
105        structure Stabilize =        structure Stabilize =
106            StabilizeFn (structure MachDepVC = HostMachDepVC            StabilizeFn (structure MachDepVC = HostMachDepVC
107                         fun recomp gp g = let                         fun recomp gp g = let
108                               val GroupGraph.GROUP { grouppath, ... } = g
109                             val { store, get } = BFC.new ()                             val { store, get } = BFC.new ()
110                             val { group, ... } =                             val { group, ... } =
111                                 Compile.newTraversal (Link.evict, store, g)                                 Compile.newTraversal (Link.evict, store, g)
112                         in                         in
113                             case group gp of                             case Servers.withServers (fn () => group gp) of
114                                 NONE => NONE                                 NONE => NONE
115                               | SOME _ => SOME get                               | SOME _ => SOME get
116                         end                         end
117                         fun destroy_state gp i =                         fun destroy_state gp i =
118                             (Compile.evict i; Link.evict gp i)                             (Compile.evict i;
119                                Servers.evict i;
120                                Link.evict gp i)
121                         val getII = Compile.getII)                         val getII = Compile.getII)
122    
123        (* Access to the stabilization mechanism is integrated into the        (* Access to the stabilization mechanism is integrated into the
# Line 205  Line 211 
211                val c = SrcPath.cwdContext ()                val c = SrcPath.cwdContext ()
212                val p = SrcPath.standard pcmode { context = c, spec = s }                val p = SrcPath.standard pcmode { context = c, spec = s }
213            in            in
214                  Servers.cm p;
215                case Parse.parse NONE (param ()) sflag p of                case Parse.parse NONE (param ()) sflag p of
216                    NONE => false                    NONE => false
217                  | SOME (g, gp) => f gp g                  | SOME (g, gp) =>
218                          (f gp g
219                           before Servers.reset ())
220            end            end
221    
222            val listLibs = Parse.listLibs            val listLibs = Parse.listLibs
# Line 224  Line 233 
233            val recomp = run NONE recomp_runner            val recomp = run NONE recomp_runner
234            val make = run NONE make_runner            val make = run NONE make_runner
235    
236              fun slave () = let
237                  fun shutdown () = OS.Process.exit OS.Process.success
238                  fun say_ok () = Say.say ["SLAVE: ok\n"]
239                  fun say_error () = Say.say ["SLAVE: error\n"]
240    
241                  fun waitForStart () = let
242                      val line = TextIO.inputLine TextIO.stdIn
243                  in
244                      if line = "" then shutdown ()
245                      else case String.tokens Char.isSpace line of
246                          ["cm", d, f] => do_cm (d, f)
247                        | ["cmb", d, db] => do_cmb (d, db)
248                        | ["shutdown"] => shutdown ()
249                        | _ => (say_error (); waitForStart ())
250                  end handle _ => (say_error (); waitForStart ())
251    
252                  and do_cmb (d, db) = let
253                      val _ = OS.FileSys.chDir d
254                      val c = SrcPath.cwdContext ()
255                  in
256                      case CMBSlave.slave make db of
257                          NONE => (say_error (); waitForStart ())
258                        | SOME (g, trav, evict) => let
259                              val _ = say_ok ()
260                              val index = Reachable.snodeMap g
261                          in
262                              workLoop (index, trav, evict, c)
263                          end
264                  end handle _ => (say_error (); waitForStart ())
265    
266                  and do_cm (d, f) = let
267                      val _ = OS.FileSys.chDir d
268                      val c = SrcPath.cwdContext ()
269                      val p = SrcPath.native { context = c, spec = f }
270                  in
271                      case Parse.parse NONE (param ()) NONE p of
272                          NONE => (say_error (); waitForStart ())
273                        | SOME (g, gp) => let
274                              val _ = say_ok ()
275                              val index = Reachable.snodeMap g
276                              val trav = Compile.newSbnodeTraversal () gp
277                              fun trav' sbn = isSome (trav sbn)
278                          in
279                              workLoop (index, trav', Compile.evict, c)
280                          end
281                  end handle _ => (say_error (); waitForStart ())
282    
283                  and workLoop (index, trav, evict, c) = let
284                      fun f2sn f =
285                          SrcPathMap.find (index,
286                                           SrcPath.native { context = c,
287                                                            spec = f })
288                      fun loop () = let
289                          val line = TextIO.inputLine TextIO.stdIn
290                      in
291                          if line = "" then shutdown ()
292                          else case String.tokens Char.isSpace line of
293                              ["evict", f] =>
294                                  (case f2sn f of
295                                       NONE => loop ()
296                                     | SOME (DG.SNODE { smlinfo, ... }) =>
297                                           (evict smlinfo; loop ()))
298                            | ["compile", f] => let
299                                  val p = SrcPath.native { context = c, spec = f }
300                              in
301                                  case SrcPathMap.find (index, p) of
302                                      NONE => (say_error (); loop ())
303                                    | SOME sn => let
304                                          val sbn = DG.SB_SNODE sn
305                                      in
306                                          if trav sbn then (say_ok (); loop ())
307                                          else (say_error (); loop ())
308                                      end
309                              end
310                            | ["cm", d, f] => do_cm (d, f)
311                            | ["finish"] => (say_ok (); waitForStart ())
312                            | ["shutdown"] => shutdown ()
313                            | _ => (say_error (); loop ())
314                      end handle _ => (say_error (); loop ())
315                  in
316                      loop ()
317                  end
318              in
319                  say_ok ();                (* announce readiness *)
320                  waitForStart ()
321              end
322    
323            fun reset () =            fun reset () =
324                (Compile.reset ();                (Compile.reset ();
325                 Link.reset ();                 Link.reset ();
# Line 365  Line 461 
461                                     showPending = showPending,                                     showPending = showPending,
462                                     listLibs = listLibs,                                     listLibs = listLibs,
463                                     dismissLib = dismissLib,                                     dismissLib = dismissLib,
464                                     symval = SSV.symval })                                     symval = SSV.symval,
465                                       server_start = Servers.start,
466                                       server_stop = Servers.stop,
467                                       server_kill = Servers.kill })
468    
469                    end                    end
470            end            end
# Line 375  Line 474 
474          (system_values := de;          (system_values := de;
475           initTheValues (bootdir, er);           initTheValues (bootdir, er);
476           Cleanup.install initPaths)           Cleanup.install initPaths)
477    
478        fun procCmdLine () = let
479            fun p (f, "sml") = HostMachDepVC.Interact.useFile f
480              | p (f, "sig") = HostMachDepVC.Interact.useFile f
481              | p (f, "cm") = ignore (make f)
482              | p (f, e) =
483                    (print (concat ["!* unable to process `", f,
484                                    "' (unknown extension `", e, "')\n"]))
485            fun c f = (f, String.map Char.toLower
486                              (getOpt (OS.Path.ext f, "<none>")))
487        in
488            case SMLofNJ.getArgs () of
489                ["@CMslave"] => (#set StdConfig.verbose false; slave ())
490              | l => app (p o c) l
491        end
492    end    end
493  end  end

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

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