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 591, Mon Apr 3 01:19:20 2000 UTC revision 592, Mon Apr 3 07:04:12 2000 UTC
# Line 150  Line 150 
150              FilenamePolicy.separate { bindir = bindir, bootdir = bootdir }              FilenamePolicy.separate { bindir = bindir, bootdir = bootdir }
151                  { arch = arch, os = os }                  { arch = arch, os = os }
152    
153          fun mkParam corenv =          val param =
154              { fnpolicy = fnpolicy,              { fnpolicy = fnpolicy,
155                pcmode = pcmode,                pcmode = pcmode,
156                symval = SSV.symval,                symval = SSV.symval,
157                keep_going = keep_going,                keep_going = keep_going }
               corenv = corenv }  
158    
159          val emptydyn = E.dynamicPart E.emptyEnv          val emptydyn = E.dynamicPart E.emptyEnv
160    
161          (* first, build an initial GeneralParam.info, so we can          (* first, build an initial GeneralParam.info, so we can
162           * deal with the pervasive env and friends... *)           * deal with the pervasive env and friends... *)
163    
         val param_nocore = mkParam E.emptyEnv  
   
164          val groupreg = GroupReg.new ()          val groupreg = GroupReg.new ()
165          val errcons = EM.defaultConsumer ()          val errcons = EM.defaultConsumer ()
166          val ginfo_nocore = { param = param_nocore, groupreg = groupreg,          val ginfo = { param = param, groupreg = groupreg, errcons = errcons }
                              errcons = errcons }  
167    
168          fun mk_main_compile arg = let          fun mk_main_compile arg = let
169    
170              val { core = core_n, pervasive = perv_n, others, src } = arg              val { pervasive = perv_n, others, src } = arg
171    
172              fun recompInitGroup () = let              fun recompInitGroup () = let
173                  val ovldR = GenericVC.Control.overloadKW                  val ovldR = GenericVC.Control.overloadKW
# Line 179  Line 175 
175                  val _ = ovldR := true                  val _ = ovldR := true
176                  val sbnode = Compile.newSbnodeTraversal ()                  val sbnode = Compile.newSbnodeTraversal ()
177    
                 (* here we build a new gp -- the one that uses the freshly  
                  * brewed pervasive env, core env, and primitives *)  
                 val core = valOf (sbnode ginfo_nocore core_n)  
                 val corenv =  
                     E.mkenv { static = #statenv core (),  
                               symbolic = #symenv core (),  
                               dynamic = emptydyn }  
   
                 (* The following is a bit of a hack (but corenv is a hack  
                  * anyway): As soon as we have core available, we have to  
                  * patch the ginfo to include the correct corenv (because  
                  * virtually everybody else needs access to corenv). *)  
                 val param = mkParam corenv  
                 val ginfo =  
                     { param = param, groupreg = groupreg, errcons = errcons }  
   
178                  val perv_fsbnode = (NONE, perv_n)                  val perv_fsbnode = (NONE, perv_n)
179    
180                  fun rt n = valOf (sbnode ginfo n)                  fun rt n = valOf (sbnode ginfo n)
# Line 219  Line 199 
199                  val special_exports = let                  val special_exports = let
200                      fun mkie (n, rtn) = #ie (rt2ie (n, rtn))                      fun mkie (n, rtn) = #ie (rt2ie (n, rtn))
201                  in                  in
202                      foldl SymbolMap.insert' SymbolMap.empty                      SymbolMap.insert (SymbolMap.empty,
203                         [(PervCoreAccess.pervStrSym, mkie (perv_n, pervasive)),                                        PervAccess.pervStrSym,
204                          (PervCoreAccess.coreStrSym, mkie (core_n, core))]                                        mkie (perv_n, pervasive))
205                  end                  end
206              in              in
207                  (GG.GROUP { exports = foldl add_exports special_exports others,                  GG.GROUP { exports = foldl add_exports special_exports others,
208                              kind = GroupGraph.LIB { wrapped = StringSet.empty,                              kind = GroupGraph.LIB { wrapped = StringSet.empty,
209                                                      subgroups = [] },                                                      subgroups = [] },
210                              required = StringSet.singleton "primitive",                              required = StringSet.singleton "primitive",
211                              grouppath = initgspec,                              grouppath = initgspec,
212                              sublibs = [] },                             sublibs = [] }
                  corenv)  
213                  before (ovldR := savedOvld)                  before (ovldR := savedOvld)
214              end              end
215    
216              (* just go and load the stable init group or signal failure *)              (* just go and load the stable init group or signal failure *)
217              fun loadInitGroup () = let              fun loadInitGroup () = let
                 val coresym = PervCoreAccess.coreStrSym  
218                  val lsarg =                  val lsarg =
219                      { getGroup = fn _ => raise Fail "CMB: initial getGroup",                      { getGroup = fn _ => raise Fail "CMB: initial getGroup",
220                        anyerrors = ref false }                        anyerrors = ref false }
221              in              in
222                  case Stabilize.loadStable ginfo_nocore lsarg initgspec of                  case Stabilize.loadStable ginfo lsarg initgspec of
223                      NONE => NONE                      NONE => NONE
224                    | SOME (g as GG.GROUP { exports, ... }) =>                    | SOME (g as GG.GROUP { exports, ... }) => SOME g
                         (case SymbolMap.find (exports, coresym) of  
                              SOME ((_, DG.SB_BNODE (_, ii)), _) => let  
                                  val stat = #statenv ii ()  
                                  val sym = #symenv ii ()  
                                  val corenv =  
                                      E.mkenv { static = stat,  
                                                symbolic = sym,  
                                                dynamic = emptydyn }  
                              in  
                                  SOME (g, corenv)  
                              end  
                            | _ => NONE)  
225                    | SOME GG.ERRORGROUP => NONE                    | SOME GG.ERRORGROUP => NONE
226              end              end
227    
228              (* Don't try to load the stable init group. Instead, recompile              (* Don't try to load the stable init group. Instead, recompile
229               * directly. *)               * directly. *)
230              fun dontLoadInitGroup () = let              fun dontLoadInitGroup () = let
231                  val (g0, corenv) = recompInitGroup ()                  val g0 = recompInitGroup ()
232                  val stabarg = { group = g0, anyerrors = ref false }                  val stabarg = { group = g0, anyerrors = ref false }
233              in              in
234                  if deliver then                  if deliver then
235                      case Stabilize.stabilize ginfo_nocore stabarg of                      case Stabilize.stabilize ginfo stabarg of
236                          SOME g => (g, corenv)                          SOME g => g
237                        | NONE => raise Fail "CMB: cannot stabilize init group"                        | NONE => raise Fail "CMB: cannot stabilize init group"
238                  else (g0, corenv)                  else g0
239              end              end
240    
241              (* Try loading the init group from the stable file if possible;              (* Try loading the init group from the stable file if possible;
# Line 281  Line 247 
247    
248              (* Ok, now, based on "paranoid" and stable verification,              (* Ok, now, based on "paranoid" and stable verification,
249               * call the appropriate function(s) to get the init group. *)               * call the appropriate function(s) to get the init group. *)
250              val (init_group, corenv) =              val init_group =
251                  if paranoid then let                  if paranoid then let
252                      val export_nodes = core_n :: perv_n :: others                      val export_nodes = perv_n :: others
253                      val ver_arg = (initgspec, export_nodes, [],                      val ver_arg = (initgspec, export_nodes, [],
254                                     SrcPathSet.empty)                                     SrcPathSet.empty)
255                      val em = StableMap.empty                      val em = StableMap.empty
256                  in                  in
257                      if VerifyStable.verify' ginfo_nocore em ver_arg then                      if VerifyStable.verify' ginfo em ver_arg then
258                          tryLoadInitGroup ()                          tryLoadInitGroup ()
259                      else dontLoadInitGroup ()                      else dontLoadInitGroup ()
260                  end                  end
261                  else tryLoadInitGroup ()                  else tryLoadInitGroup ()
262    
             (* now we finally build the real param and ginfo that we can  
              * use throughout the rest... *)  
             val param = mkParam corenv  
             val ginfo =  
                 { param = param, errcons = errcons, groupreg = groupreg }  
263    
264              val stab = if deliver then SOME true else NONE              val stab = if deliver then SOME true else NONE
265    
# Line 394  Line 355 
355          end handle Option => (Compile.reset (); NONE)          end handle Option => (Compile.reset (); NONE)
356                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
357      in      in
358          case BuildInitDG.build ginfo_nocore initgspec of          case BuildInitDG.build ginfo initgspec of
359              SOME x => mk_main_compile x              SOME x => mk_main_compile x
360            | NONE => NONE            | NONE => NONE
361      end      end

Legend:
Removed from v.591  
changed lines
  Added in v.592

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