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/bootstrap/btcompile.sml
ViewVC logotype

Diff of /sml/trunk/src/cm/bootstrap/btcompile.sml

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

revision 448, Thu Oct 21 09:20:16 1999 UTC revision 449, Fri Oct 22 07:35:29 1999 UTC
# Line 29  Line 29 
29      structure BF = MachDepVC.Binfile      structure BF = MachDepVC.Binfile
30    
31      structure Compile = CompileFn (structure MachDepVC = MachDepVC      structure Compile = CompileFn (structure MachDepVC = MachDepVC
32                                     fun compile_there _ = false)                                     val compile_there = Servers.compile)
33    
34      structure BFC = BfcFn (structure MachDepVC = MachDepVC)      structure BFC = BfcFn (structure MachDepVC = MachDepVC)
35    
# Line 87  Line 87 
87                    AutoDir.openBinOut, BinIO.closeOut,                    AutoDir.openBinOut, BinIO.closeOut,
88                    BinIO.inputN, BinIO.output, BinIO.endOfStream)                    BinIO.inputN, BinIO.output, BinIO.endOfStream)
89    
90      fun compile deliver dbopt = let      fun mk_compile deliver dbopt = let
91    
92          val dirbase = getOpt (dbopt, BtNames.dirbaseDefault)          val dirbase = getOpt (dbopt, BtNames.dirbaseDefault)
93          val pcmodespec = BtNames.pcmodespec          val pcmodespec = BtNames.pcmodespec
# Line 171  Line 171 
171          val ginfo_nocore = { param = param_nocore, groupreg = groupreg,          val ginfo_nocore = { param = param_nocore, groupreg = groupreg,
172                               errcons = errcons }                               errcons = errcons }
173    
174          fun main_compile arg = let          fun mk_main_compile arg = let
175              val { rts, core, pervasive, primitives, binpaths } = arg              val { rts, core, pervasive, primitives, binpaths } = arg
176    
177              val ovldR = GenericVC.Control.overloadKW              val ovldR = GenericVC.Control.overloadKW
# Line 235  Line 235 
235                  if deliver then SOME true else NONE                  if deliver then SOME true else NONE
236          in          in
237              case Parse.parse NONE param stab maingspec of              case Parse.parse NONE param stab maingspec of
238                  NONE => false                  NONE => NONE
239                | SOME (g, gp) => let                | SOME (g, gp) => let
240                        fun thunk () = let
241                      fun store _ = ()                      fun store _ = ()
242                      val { group = recomp, ... } =                      val { group = recomp, ... } =
243                          Compile.newTraversal (fn _ => fn _ => (), store, g)                          Compile.newTraversal (fn _ => fn _ => (), store, g)
# Line 254  Line 255 
255                                  concat [listName (p, false),                                  concat [listName (p, false),
256                                          "@", Int.toString off, ":", desc]                                          "@", Int.toString off, ":", desc]
257                              val bootstrings =                              val bootstrings =
258                                  foldr add (map transcribe (MkBootList.group g))                                      foldr add
259                                              (map transcribe (MkBootList.group g))
260                                        binpaths                                        binpaths
261                              fun show str =                              fun show str =
262                                  (TextIO.output (s, str);                                  (TextIO.output (s, str);
# Line 264  Line 266 
266                          end                          end
267                      in                      in
268                        if deliver then                        if deliver then
269                         (SafeIO.perform { openIt = fn () =>                                  (SafeIO.perform
270                                     { openIt = fn () =>
271                                             AutoDir.openTextOut pidfile,                                             AutoDir.openTextOut pidfile,
272                                           closeIt = TextIO.closeOut,                                           closeIt = TextIO.closeOut,
273                                           work = fn s =>                                           work = fn s =>
# Line 272  Line 275 
275                                           cleanup = fn () =>                                           cleanup = fn () =>
276                                             OS.FileSys.remove pidfile                                             OS.FileSys.remove pidfile
277                                             handle _ => () };                                             handle _ => () };
278                          SafeIO.perform { openIt = fn () =>                                   SafeIO.perform
279                                     { openIt = fn () =>
280                                             AutoDir.openTextOut listfile,                                             AutoDir.openTextOut listfile,
281                                           closeIt = TextIO.closeOut,                                           closeIt = TextIO.closeOut,
282                                           work = writeList,                                           work = writeList,
283                                           cleanup = fn () =>                                           cleanup = fn () =>
284                                             OS.FileSys.remove listfile                                             OS.FileSys.remove listfile
285                                             handle _ => () };                                             handle _ => () };
286                          copyTextFile (SrcPath.osstring initgspec, cmifile);                                   copyTextFile (SrcPath.osstring initgspec,
287                          Say.say ["Runtime System PID is: ", rtspid, "\n"])                                                 cmifile);
288                                     Say.say ["Runtime System PID is: ",
289                                              rtspid, "\n"])
290                        else ();                        else ();
291                        true                        true
292                      end                      end
293                      else false                      else false
294                  end                  end
295          end handle Option => (Compile.reset (); false)                  in
296                        SOME ((g, gp), thunk, dirbase)
297                    end
298            end handle Option => (Compile.reset (); NONE)
299                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
300      in      in
301          case BuildInitDG.build ginfo_nocore initgspec of          case BuildInitDG.build ginfo_nocore initgspec of
302              SOME x => main_compile x              SOME x => mk_main_compile x
303            | NONE => false            | NONE => NONE
304        end
305    
306        fun compile deliver dbopt =
307            (Servers.disable ();            (* no parallel stuff during init *)
308             case mk_compile deliver dbopt of
309                 NONE => false
310               | SOME (_, thunk, db) =>
311                     (Servers.enable ();
312                      Servers.cmb db;
313                      thunk ()
314                      before Servers.waitforall ()))
315    
316        local
317            fun slave dirbase =
318                case mk_compile false (SOME dirbase) of
319                    NONE => NONE
320                  | SOME ((g, gp), _, _) => let
321                        val trav = Compile.newSbnodeTraversal () gp
322                        fun trav' sbn = isSome (trav sbn)
323                    in
324                        SOME (g, gp, trav')
325                    end
326        in
327            val _ = CMBSlaveHook.init slave
328      end      end
329    
330      fun reset () =      fun reset () =

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

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