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 372, Tue Jul 6 09:05:57 1999 UTC revision 398, Wed Aug 25 15:36:43 1999 UTC
# Line 26  Line 26 
26      structure P = OS.Path      structure P = OS.Path
27      structure F = OS.FileSys      structure F = OS.FileSys
28    
29    (*
30      (* Since the bootstrap compiler never executes any of the code      (* Since the bootstrap compiler never executes any of the code
31       * it produces, we don't need any dynamic values.  Therefore,       * it produces, we don't need any dynamic values.  Therefore,
32       * we create RecompPersstate (but not FullPersstate!) and       * we create RecompPersstate (but not FullPersstate!) and
# Line 42  Line 43 
43      structure RT = CompileGenericFn (structure CT = Recomp)      structure RT = CompileGenericFn (structure CT = Recomp)
44    
45      fun recomp gp g = isSome (RT.group gp g)      fun recomp gp g = isSome (RT.group gp g)
46    *)
47    
48        structure Compile =
49            CompileFn (structure MachDepVC = MachDepVC)
50    
51      (* instantiate Stabilize... *)      (* instantiate Stabilize... *)
52    (*
53      structure Stabilize =      structure Stabilize =
54          StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode' gp i)))          StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode' gp i)))
55                       fun warmup (i, p) = ()                       fun warmup (i, p) = ()
56                       val recomp = recomp                       val recomp = recomp
57                       val transfer_state = RecompPersstate.transfer_state)                       val transfer_state = RecompPersstate.transfer_state)
58    *)
59        structure Stabilize =
60            StabilizeFn (fun transfer_state _ = raise Fail "transfer_state"
61                         val writeBFC = Compile.writeBFC
62                         val sizeBFC = Compile.sizeBFC
63                         val getII = Compile.getII
64                         val recomp = Compile.recomp)
65    
66      (* ... and Parse *)      (* ... and Parse *)
67      structure Parse = ParseFn (structure Stabilize = Stabilize      structure Parse = ParseFn (structure Stabilize = Stabilize
68                                 fun pending () = SymbolMap.empty)                                 fun pending () = SymbolMap.empty)
# Line 177  Line 191 
191              val ovldR = GenericVC.Control.overloadKW              val ovldR = GenericVC.Control.overloadKW
192              val savedOvld = !ovldR              val savedOvld = !ovldR
193              val _ = ovldR := true              val _ = ovldR := true
194              val ts = RT.start ()              val { sbnode, ... } = Compile.newTraversal ()
195    
196              (* here we build a new gp -- the one that uses the freshly              (* here we build a new gp -- the one that uses the freshly
197               * brewed pervasive env, core env, and primitives *)               * brewed pervasive env, core env, and primitives *)
198              val core = valOf (RT.sbnode ts ginfo_nocore core)              val core = valOf (sbnode ginfo_nocore core)
199              val corenv =  CoerceEnv.es2bs (#1 (#stat core))              val corenv =  CoerceEnv.es2bs (#statenv (#ii core) ())
200              val core_sym = #1 (#sym core)              val core_sym = #symenv (#ii core) ()
201    
202              (* The following is a bit of a hack (but corenv is a hack anyway):              (* The following is a bit of a hack (but corenv is a hack anyway):
203               * As soon as we have core available, we have to patch the               * As soon as we have core available, we have to patch the
# Line 193  Line 207 
207              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
208                                     errcons = errcons }                                     errcons = errcons }
209    
210              fun rt n = valOf (RT.sbnode ts ginfo_justcore n)              fun rt n = valOf (sbnode ginfo_justcore n)
211              val rts = rt rts              val rts = rt rts
212              val pervasive = rt pervasive              val pervasive = rt pervasive
213    
214              fun sn2pspec (name, n) = let              fun sn2pspec (name, n) = let
215                  val { stat = (s, sp), sym = (sy, syp), ctxt, bfc } = rt n                  val { ii = { statenv, symenv, statpid, sympid }, ctxt } = rt n
216                  val env =                  val env =
217                      E.mkenv { static = s, symbolic = sy, dynamic = emptydyn }                      E.mkenv { static = statenv (),
218                  val pidInfo = { statpid = sp, sympid = syp, ctxt = ctxt }                                symbolic = symenv (),
219                                  dynamic = emptydyn }
220                    val pidInfo =
221                        { statpid = statpid, sympid = sympid, ctxt = ctxt }
222              in              in
223                  { name = name, env = env, pidInfo = pidInfo }                  { name = name, env = env, pidInfo = pidInfo }
224              end              end
# Line 210  Line 227 
227    
228              val _ = ovldR := savedOvld              val _ = ovldR := savedOvld
229    
             (* To be consistent, we would have to call RT.finish here.  
              * However, this isn't really necessary because no dynamic  
              * values exist and we drop "ts" at this point anyway. *)  
             (* val _ = RT.finish ts *)  
   
230              (* The following is a hack but must be done for both the symbolic              (* The following is a hack but must be done for both the symbolic
231               * and later the dynamic part of the core environment:               * and later the dynamic part of the core environment:
232               * we must include these parts in the pervasive env. *)               * we must include these parts in the pervasive env. *)
233              val perv_sym = E.layerSymbolic (#1 (#sym pervasive), core_sym)              val perv_sym = E.layerSymbolic (#symenv (#ii pervasive) (),
234                                                core_sym)
235    
236              val param =              val param =
237                  mkParam { primconf = Primitive.configuration pspecs,                  mkParam { primconf = Primitive.configuration pspecs,
238                            pervasive = E.mkenv { static = #1 (#stat pervasive),                            pervasive = E.mkenv { static =
239                                                     #statenv (#ii pervasive) (),
240                                                  symbolic = perv_sym,                                                  symbolic = perv_sym,
241                                                  dynamic = emptydyn },                                                  dynamic = emptydyn },
242                            pervcorepids =                            pervcorepids =
243                              PidSet.addList (PidSet.empty,                              PidSet.addList (PidSet.empty,
244                                              [#2 (#stat pervasive),                                              [#statpid (#ii pervasive),
245                                               #2 (#sym pervasive),                                               #sympid (#ii pervasive),
246                                               #2 (#stat core)]) }                                               #statpid (#ii core)]) }
247                          { corenv = corenv }                          { corenv = corenv }
248              val stab =              val stab =
249                  if deliver then SOME true else NONE                  if deliver then SOME true else NONE
# Line 237  Line 251 
251              case Parse.parse NONE param stab maingspec of              case Parse.parse NONE param stab maingspec of
252                  NONE => false                  NONE => false
253                | SOME (g, gp) =>                | SOME (g, gp) =>
254                      if recomp gp g then let                      if Compile.recomp gp g then let
255                          val rtspid = PS.toHex (#2 (#stat rts))                          val rtspid = PS.toHex (#statpid (#ii rts))
256                          fun writeList s = let                          fun writeList s = let
257                              fun add ((p, flag), l) = let                              fun add ((p, flag), l) = let
258                                  val n = listName (p, true)                                  val n = listName (p, true)
# Line 281  Line 295 
295                        true                        true
296                      end                      end
297                      else false                      else false
298          end handle Option => (RT.reset (); false)          end handle Option => (Compile.reset (); false)
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
# Line 289  Line 303 
303            | NONE => false            | NONE => false
304      end      end
305    
306        fun reset () =
307            (Compile.reset ();
308             Parse.reset ())
309    
310      val make' = compile false      val make' = compile false
311      fun make () = make' NONE      fun make () = make' NONE
312      val deliver' = compile true      fun deliver' arg =
313            SafeIO.perform { openIt = fn () => (),
314                             closeIt = reset,
315                             work = fn () => compile true arg,
316                             cleanup = fn () => () }
317      fun deliver () = deliver' NONE      fun deliver () = deliver' NONE
     fun reset () =  
         (RecompPersstate.reset ();  
          RT.reset ();  
          Recomp.reset ();  
          Parse.reset ())  
318  end  end

Legend:
Removed from v.372  
changed lines
  Added in v.398

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