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 800, Fri Mar 16 17:22:47 2001 UTC revision 801, Mon Mar 19 22:53:00 2001 UTC
# Line 52  Line 52 
52                       structure StabModmap = StabModmap                       structure StabModmap = StabModmap
53                       fun recomp gp g = let                       fun recomp gp g = let
54                           val { store, get } = BFC.new ()                           val { store, get } = BFC.new ()
55                           val _ = init_servers g                           fun dummy _ _ = ()
56                           val { group, ... } =                           val { group, ... } =
57                               Compile.newTraversal (fn _ => fn _ => (),                               Compile.newTraversal (dummy, store, g)
                                                    store, g)  
58                       in                       in
59                           case Servers.withServers (fn () => group gp) of                           case group gp of
60                               NONE => NONE                               NONE => NONE
61                             | SOME _ => SOME get                             | SOME _ => SOME get
62                       end                       end
# Line 114  Line 113 
113          end          end
114      end      end
115    
116      fun mk_compile { deliver, root, dirbase = dbopt, paranoid } = let      fun mk_compile { master, root, dirbase = dbopt } = let
117    
118          val dirbase = getOpt (dbopt, BtNames.dirbaseDefault)          val dirbase = getOpt (dbopt, BtNames.dirbaseDefault)
119          val _ = checkDirbase dirbase          val _ = checkDirbase dirbase
# Line 250  Line 249 
249                  val stabarg = { group = g0, anyerrors = ref false,                  val stabarg = { group = g0, anyerrors = ref false,
250                                  rebindings = [] }                                  rebindings = [] }
251              in              in
252                  if deliver then                  if master then
253                      case Stabilize.stabilize ginfo stabarg of                      case Stabilize.stabilize ginfo stabarg of
254                          SOME g => g                          SOME g => g
255                        | NONE => raise Fail "CMB: cannot stabilize init group"                        | NONE => raise Fail "CMB: cannot stabilize init group"
# Line 267  Line 266 
266              (* Ok, now, based on "paranoid" and stable verification,              (* Ok, now, based on "paranoid" and stable verification,
267               * call the appropriate function(s) to get the init group. *)               * call the appropriate function(s) to get the init group. *)
268              val init_group =              val init_group =
269                  if paranoid then let                  if master then let
270                      val export_nodes = perv_n :: others                      val export_nodes = perv_n :: others
271                      val ver_arg = (initgspec, export_nodes, [],                      val ver_arg = (initgspec, export_nodes, [],
272                                     SrcPathSet.empty, NONE)                                     SrcPathSet.empty, NONE)
# Line 277  Line 276 
276                          tryLoadInitGroup ()                          tryLoadInitGroup ()
277                      else dontLoadInitGroup ()                      else dontLoadInitGroup ()
278                  end                  end
279                  else tryLoadInitGroup ()                  else valOf (loadInitGroup ()) (* failure caught at the end *)
   
   
             val stab = if deliver then SOME true else NONE  
280    
281              val gr = GroupReg.new ()              val gr = GroupReg.new ()
282              val _ = GroupReg.register gr (initgspec, src)              val _ = GroupReg.register gr (initgspec, src)
283    
284              val parse_arg =              fun parse_arg (s, p) =
285                  { load_plugin = load_plugin,                  { load_plugin = load_plugin,
286                    gr = gr,                    gr = gr,
287                    param = param,                    param = param,
288                    stabflag = stab,                    stabflag = s,
289                    group = maingspec,                    group = maingspec,
290                    init_group = init_group,                    init_group = init_group,
291                    paranoid = paranoid }                    paranoid = p }
292    
293                val lonely_master = master andalso Servers.noServers ()
294    
295                val initial_parse_arg =
296                    if lonely_master then parse_arg (SOME true, true)
297                    else parse_arg (NONE, master)
298          in          in
299              Servers.dirbase dirbase;              case Parse.parse initial_parse_arg of
             Servers.cmb_new { archos = archos };  
             case Parse.parse parse_arg of  
300                  NONE => NONE                  NONE => NONE
301                | SOME (g, gp) => let                | SOME (g, gp) => let
302                      fun thunk () = let                      fun finish (g, gp) = let
                         val _ = init_servers g  
                         fun store _ = ()  
                         val { group = recomp, ... } =  
                             Compile.newTraversal (fn _ => fn _ => (), store, g)  
                         val res =  
                             Servers.withServers (fn () => recomp gp)  
                     in  
                         if isSome res then let  
303                              val { l = bootitems, ss } = mkBootList g                              val { l = bootitems, ss } = mkBootList g
304                              val stablelibs = Reachable.stableLibsOf g                              val stablelibs = Reachable.stableLibsOf g
305                              fun inSet bi = StableSet.member (ss, bi)                              fun inSet bi = StableSet.member (ss, bi)
# Line 328  Line 320 
320                                  val sn = BinInfo.stablename i                                  val sn = BinInfo.stablename i
321                                  val os = BinInfo.offset i                                  val os = BinInfo.offset i
322                                  val descr = BinInfo.describe i                                  val descr = BinInfo.describe i
323                                  val bfc = BFC.getStable                              val bfc = BFC.getStable { stable = sn, offset = os,
324                                      { stable = sn, offset = os, descr = descr }                                                        descr = descr }
325                              in                              in
326                                  case BF.exportPidOf bfc of                                  case BF.exportPidOf bfc of
327                                      NONE => ()                                      NONE => ()
328                                    | SOME pid =>                                    | SOME pid =>
329                                      app (fn str => TextIO.output (s, str))                                      app (fn str => TextIO.output (s, str))
330                                          [" ", Int.toString os,                                      [" ", Int.toString os, ":", PS.toHex pid]
                                          ":", PS.toHex pid]  
331                              end                              end
332                              fun writePidLine s (p, set) =                              fun writePidLine s (p, set) =
333                                  if StableSet.isEmpty set then ()                                  if StableSet.isEmpty set then ()
# Line 346  Line 337 
337                              fun writePidMap s =                              fun writePidMap s =
338                                  SrcPathMap.appi (writePidLine s) frontiers                                  SrcPathMap.appi (writePidLine s) frontiers
339                          in                          in
340                              if deliver then                          SafeIO.perform
341                                  (SafeIO.perform                              { openIt = fn () => AutoDir.openTextOut listfile,
                                  { openIt = fn () =>  
                                        AutoDir.openTextOut listfile,  
342                                     closeIt = TextIO.closeOut,                                     closeIt = TextIO.closeOut,
343                                     work = writeBootList,                                     work = writeBootList,
344                                     cleanup = fn _ =>                                cleanup = fn _ => (OS.FileSys.remove listfile
345                                         OS.FileSys.remove listfile                                                   handle _ => ()) };
                                        handle _ => () };  
346                                   SafeIO.perform                                   SafeIO.perform
347                                   { openIt = fn () =>                              { openIt = fn () => AutoDir.openTextOut pidmapfile,
                                        AutoDir.openTextOut pidmapfile,  
348                                     closeIt = TextIO.closeOut,                                     closeIt = TextIO.closeOut,
349                                     work = writePidMap,                                     work = writePidMap,
350                                     cleanup = fn _ =>                                cleanup = fn _ => (OS.FileSys.remove pidmapfile
351                                         OS.FileSys.remove pidmapfile                                                   handle _ => ()) };
352                                         handle _ => () };                          Say.say ["New boot directory has been built.\n"];
                                  Say.say  
                                       ["New boot directory has been built.\n"])  
                             else ();  
353                              true                              true
354                          end                          end
355    
356                        (* the following thunk represents phase 2 (stabilization)
357                         * of the master's execution path; it is never
358                         * executed in slave mode *)
359                        fun stabilize () =
360                            (* now we re-parse everything with stabilization
361                             * turnedon (and servers turned off *)
362                            case Parse.parse (parse_arg (SOME true, false)) of
363                                NONE => false
364                              | SOME (g, gp) => finish (g, gp)
365    
366                        (* Don't do another traversal if this is a lonely master *)
367                        fun just_stabilize () = finish (g, gp)
368    
369                        (* the following thunk is executed in "master" mode only;
370                         * slaves just throw it away *)
371                        fun compile_and_stabilize () = let
372                            (* this ought to be consolidated (from 3 make 1)... *)
373                            val _ = Servers.dirbase dirbase
374                            val _ = Servers.cmb_new { archos = archos }
375                            val _ = Servers.cmb { archos = archos,
376                                                  root = SrcPath.encode maingspec }
377    
378                            (* make compilation traversal and execute it *)
379                            val { allgroups, ... } =
380                                Compile.newTraversal (fn _ => fn _ => (),
381                                                      fn _ => (),
382                                                      g)
383                        in
384                            if Servers.withServers (fn () => allgroups gp) then
385                                (Compile.reset ();
386                                 stabilize ())
387                          else false                          else false
388                      end                      end
389                  in                  in
390                      SOME ((g, gp, penv), thunk)                      SOME ((g, gp, penv),
391                              if lonely_master then just_stabilize
392                              else compile_and_stabilize)
393                  end                  end
394          end handle Option => (Compile.reset (); NONE)          end handle Option => (Compile.reset (); NONE)
395                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" or slave's failure
396                        * to load init group *)
397      in      in
398          case BuildInitDG.build ginfo initgspec of          case BuildInitDG.build ginfo initgspec of
399              SOME x => mk_main_compile x              SOME x => mk_main_compile x
# Line 383  Line 402 
402    
403      fun compile dbopt =      fun compile dbopt =
404          (StabModmap.reset ();          (StabModmap.reset ();
405           case mk_compile { deliver = true, root = NONE,           case mk_compile { master = true, root = NONE, dirbase = dbopt } of
                            dirbase = dbopt, paranoid = true } of  
406               NONE => false               NONE => false
407             | SOME (_, thunk) => thunk ())             | SOME (_, cas) => cas ())
408    
409      local      local
410          fun slave NONE = (StabModmap.reset (); NONE)          fun slave NONE = (StabModmap.reset (); NONE)
411            | slave (SOME (dirbase, root)) =            | slave (SOME (dirbase, root)) =
412              case mk_compile { deliver = false, root = SOME root,              case mk_compile { master = false, root = SOME root,
413                                dirbase = SOME dirbase, paranoid = false } of                                dirbase = SOME dirbase } of
414                  NONE => NONE                  NONE => NONE
415                | SOME ((g, gp, penv), _) => let                | SOME ((g, gp, penv), _) => let
416                      val trav = Compile.newSbnodeTraversal ()                      val trav = Compile.newSbnodeTraversal ()

Legend:
Removed from v.800  
changed lines
  Added in v.801

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