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 450, Fri Oct 22 17:10:09 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 43  Line 43 
43                               Compile.newTraversal (fn _ => fn _ => (),                               Compile.newTraversal (fn _ => fn _ => (),
44                                                     store, g)                                                     store, g)
45                       in                       in
46                           case group gp of                           case Servers.withServers (fn () => group gp) of
47                               NONE => NONE                               NONE => NONE
48                             | SOME _ => SOME get                             | SOME _ => SOME get
49                       end                       end
# 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    
176              val { rts, core, pervasive, primitives, binpaths } = arg              val { rts, core, pervasive, primitives, binpaths } = arg
177    
178              val ovldR = GenericVC.Control.overloadKW              val ovldR = GenericVC.Control.overloadKW
# Line 233  Line 234 
234                          { corenv = corenv }                          { corenv = corenv }
235              val stab =              val stab =
236                  if deliver then SOME true else NONE                  if deliver then SOME true else NONE
237    
238                (* We need to announce the project here because Parse.parse
239                 * may already invoke the compiler (because of "deliver"). *)
240                val _ = Servers.cmb dirbase
241          in          in
242              case Parse.parse NONE param stab maingspec of              case Parse.parse NONE param stab maingspec of
243                  NONE => false                  NONE => NONE
244                | SOME (g, gp) => let                | SOME (g, gp) => let
245                        fun thunk () = let
246                      fun store _ = ()                      fun store _ = ()
247                      val { group = recomp, ... } =                      val { group = recomp, ... } =
248                          Compile.newTraversal (fn _ => fn _ => (), store, g)                          Compile.newTraversal (fn _ => fn _ => (), store, g)
249                            val res =
250                                Servers.withServers (fn () => recomp gp)
251                  in                  in
252                      if isSome (recomp gp) then let                          if isSome res then let
253                          val rtspid = PS.toHex (#statpid (#ii rts))                          val rtspid = PS.toHex (#statpid (#ii rts))
254                          fun writeList s = let                          fun writeList s = let
255                              fun add ((p, flag), l) = let                              fun add ((p, flag), l) = let
# Line 254  Line 262 
262                                  concat [listName (p, false),                                  concat [listName (p, false),
263                                          "@", Int.toString off, ":", desc]                                          "@", Int.toString off, ":", desc]
264                              val bootstrings =                              val bootstrings =
265                                  foldr add (map transcribe (MkBootList.group g))                                      foldr add
266                                              (map transcribe (MkBootList.group g))
267                                        binpaths                                        binpaths
268                              fun show str =                              fun show str =
269                                  (TextIO.output (s, str);                                  (TextIO.output (s, str);
# Line 264  Line 273 
273                          end                          end
274                      in                      in
275                        if deliver then                        if deliver then
276                         (SafeIO.perform { openIt = fn () =>                                  (SafeIO.perform
277                                     { openIt = fn () =>
278                                             AutoDir.openTextOut pidfile,                                             AutoDir.openTextOut pidfile,
279                                           closeIt = TextIO.closeOut,                                           closeIt = TextIO.closeOut,
280                                           work = fn s =>                                           work = fn s =>
# Line 272  Line 282 
282                                           cleanup = fn () =>                                           cleanup = fn () =>
283                                             OS.FileSys.remove pidfile                                             OS.FileSys.remove pidfile
284                                             handle _ => () };                                             handle _ => () };
285                          SafeIO.perform { openIt = fn () =>                                   SafeIO.perform
286                                     { openIt = fn () =>
287                                             AutoDir.openTextOut listfile,                                             AutoDir.openTextOut listfile,
288                                           closeIt = TextIO.closeOut,                                           closeIt = TextIO.closeOut,
289                                           work = writeList,                                           work = writeList,
290                                           cleanup = fn () =>                                           cleanup = fn () =>
291                                             OS.FileSys.remove listfile                                             OS.FileSys.remove listfile
292                                             handle _ => () };                                             handle _ => () };
293                          copyTextFile (SrcPath.osstring initgspec, cmifile);                                   copyTextFile (SrcPath.osstring initgspec,
294                          Say.say ["Runtime System PID is: ", rtspid, "\n"])                                                 cmifile);
295                                     Say.say ["Runtime System PID is: ",
296                                              rtspid, "\n"])
297                        else ();                        else ();
298                        true                        true
299                      end                      end
300                      else false                      else false
301                  end                  end
302          end handle Option => (Compile.reset (); false)                  in
303                        SOME ((g, gp), thunk)
304                    end
305            end handle Option => (Compile.reset (); NONE)
306                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
307      in      in
308          case BuildInitDG.build ginfo_nocore initgspec of          case BuildInitDG.build ginfo_nocore initgspec of
309              SOME x => main_compile x              SOME x => mk_main_compile x
310            | NONE => false            | NONE => NONE
311        end
312    
313        fun compile deliver dbopt =
314            case mk_compile deliver dbopt of
315                NONE => false
316              | SOME (_, thunk) => thunk () before Servers.waitforall ()
317    
318        local
319            fun slave dirbase =
320                case mk_compile false (SOME dirbase) of
321                    NONE => NONE
322                  | SOME ((g, gp), _) => let
323                        val trav = Compile.newSbnodeTraversal () gp
324                        fun trav' sbn = isSome (trav sbn)
325                    in
326                        SOME (g, gp, trav')
327                    end
328        in
329            val _ = CMBSlaveHook.init slave
330      end      end
331    
332      fun reset () =      fun reset () =

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

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