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 433, Mon Sep 13 06:57:29 1999 UTC
# Line 25  Line 25 
25                                        val os = os)                                        val os = os)
26      structure P = OS.Path      structure P = OS.Path
27      structure F = OS.FileSys      structure F = OS.FileSys
28        structure BF = MachDepVC.Binfile
29    
30      (* Since the bootstrap compiler never executes any of the code      structure Compile = CompileFn (structure MachDepVC = MachDepVC)
      * it produces, we don't need any dynamic values.  Therefore,  
      * we create RecompPersstate (but not FullPersstate!) and  
      * instantiate Recomp as well as RecompTraversal.  
      * Since RecompPersstate is not part of any surrounding FullPersstate,  
      * function "discard_value" simply does nothing. *)  
     structure RecompPersstate =  
         RecompPersstateFn (structure MachDepVC = MachDepVC  
                            val discard_code = true  
                            fun stable_value_present i = false  
                            fun new_smlinfo i = ())  
31    
32      structure Recomp = RecompFn (structure PS = RecompPersstate)      structure BFC = BfcFn (structure MachDepVC = MachDepVC)
     structure RT = CompileGenericFn (structure CT = Recomp)  
   
     fun recomp gp g = isSome (RT.group gp g)  
33    
34      (* instantiate Stabilize... *)      (* instantiate Stabilize... *)
35      structure Stabilize =      structure Stabilize =
36          StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode' gp i)))          StabilizeFn (fun destroy_state _ i = Compile.evict i
37                       fun warmup (i, p) = ()                       structure MachDepVC = MachDepVC
38                       val recomp = recomp                       fun recomp gp g = let
39                       val transfer_state = RecompPersstate.transfer_state)                           val { store, get } = BFC.new ()
40                             val { group, ... } =
41                                 Compile.newTraversal (fn _ => fn _ => (),
42                                                       store, g)
43                         in
44                             case group gp of
45                                 NONE => NONE
46                               | SOME _ => SOME get
47                         end
48                         val getII = Compile.getII)
49    
50      (* ... and Parse *)      (* ... and Parse *)
51      structure Parse = ParseFn (structure Stabilize = Stabilize      structure Parse = ParseFn (structure Stabilize = Stabilize
52                                 fun pending () = SymbolMap.empty)                                 fun pending () = SymbolMap.empty)
# Line 121  Line 119 
119                  end                  end
120                | _ => raise Fail "BootstrapCompile:listName: bad name"                | _ => raise Fail "BootstrapCompile:listName: bad name"
121    
122          val keep_going = EnvConfig.getSet StdConfig.keep_going NONE          val keep_going = #get StdConfig.keep_going ()
123    
124          val ctxt = SrcPath.cwdContext ()          val ctxt = SrcPath.cwdContext ()
125    
# Line 148  Line 146 
146              { primconf = primconf,              { primconf = primconf,
147                fnpolicy = fnpolicy,                fnpolicy = fnpolicy,
148                pcmode = pcmode,                pcmode = pcmode,
149                symenv = SSV.env,                symval = SSV.symval,
150                keep_going = keep_going,                keep_going = keep_going,
151                pervasive = pervasive,                pervasive = pervasive,
152                corenv = corenv,                corenv = corenv,
# Line 177  Line 175 
175              val ovldR = GenericVC.Control.overloadKW              val ovldR = GenericVC.Control.overloadKW
176              val savedOvld = !ovldR              val savedOvld = !ovldR
177              val _ = ovldR := true              val _ = ovldR := true
178              val ts = RT.start ()              val sbnode = Compile.newSbnodeTraversal ()
179    
180              (* here we build a new gp -- the one that uses the freshly              (* here we build a new gp -- the one that uses the freshly
181               * brewed pervasive env, core env, and primitives *)               * brewed pervasive env, core env, and primitives *)
182              val core = valOf (RT.sbnode ts ginfo_nocore core)              val core = valOf (sbnode ginfo_nocore core)
183              val corenv =  CoerceEnv.es2bs (#1 (#stat core))              val corenv =  CoerceEnv.es2bs (#statenv (#ii core) ())
184              val core_sym = #1 (#sym core)              val core_sym = #symenv (#ii core) ()
185    
186              (* 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):
187               * 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 191 
191              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
192                                     errcons = errcons }                                     errcons = errcons }
193    
194              fun rt n = valOf (RT.sbnode ts ginfo_justcore n)              fun rt n = valOf (sbnode ginfo_justcore n)
195              val rts = rt rts              val rts = rt rts
196              val pervasive = rt pervasive              val pervasive = rt pervasive
197    
198              fun sn2pspec (name, n) = let              fun sn2pspec (name, n) = let
199                  val { stat = (s, sp), sym = (sy, syp), ctxt, bfc } = rt n                  val { ii = { statenv, symenv, statpid, sympid }, ctxt } = rt n
200                  val env =                  val env =
201                      E.mkenv { static = s, symbolic = sy, dynamic = emptydyn }                      E.mkenv { static = statenv (),
202                  val pidInfo = { statpid = sp, sympid = syp, ctxt = ctxt }                                symbolic = symenv (),
203                                  dynamic = emptydyn }
204                    val pidInfo =
205                        { statpid = statpid, sympid = sympid, ctxt = ctxt }
206              in              in
207                  { name = name, env = env, pidInfo = pidInfo }                  { name = name, env = env, pidInfo = pidInfo }
208              end              end
# Line 210  Line 211 
211    
212              val _ = ovldR := savedOvld              val _ = ovldR := savedOvld
213    
             (* 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 *)  
   
214              (* 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
215               * and later the dynamic part of the core environment:               * and later the dynamic part of the core environment:
216               * we must include these parts in the pervasive env. *)               * we must include these parts in the pervasive env. *)
217              val perv_sym = E.layerSymbolic (#1 (#sym pervasive), core_sym)              val perv_sym = E.layerSymbolic (#symenv (#ii pervasive) (),
218                                                core_sym)
219    
220              val param =              val param =
221                  mkParam { primconf = Primitive.configuration pspecs,                  mkParam { primconf = Primitive.configuration pspecs,
222                            pervasive = E.mkenv { static = #1 (#stat pervasive),                            pervasive = E.mkenv { static =
223                                                     #statenv (#ii pervasive) (),
224                                                  symbolic = perv_sym,                                                  symbolic = perv_sym,
225                                                  dynamic = emptydyn },                                                  dynamic = emptydyn },
226                            pervcorepids =                            pervcorepids =
227                              PidSet.addList (PidSet.empty,                              PidSet.addList (PidSet.empty,
228                                              [#2 (#stat pervasive),                                              [#statpid (#ii pervasive),
229                                               #2 (#sym pervasive),                                               #sympid (#ii pervasive),
230                                               #2 (#stat core)]) }                                               #statpid (#ii core)]) }
231                          { corenv = corenv }                          { corenv = corenv }
232              val stab =              val stab =
233                  if deliver then SOME true else NONE                  if deliver then SOME true else NONE
234          in          in
235              case Parse.parse NONE param stab maingspec of              case Parse.parse NONE param stab maingspec of
236                  NONE => false                  NONE => false
237                | SOME (g, gp) =>                | SOME (g, gp) => let
238                      if recomp gp g then let                      fun store _ = ()
239                          val rtspid = PS.toHex (#2 (#stat rts))                      val { group = recomp, ... } =
240                            Compile.newTraversal (fn _ => fn _ => (), store, g)
241                    in
242                        if isSome (recomp gp) then let
243                            val rtspid = PS.toHex (#statpid (#ii rts))
244                          fun writeList s = let                          fun writeList s = let
245                              fun add ((p, flag), l) = let                              fun add ((p, flag), l) = let
246                                  val n = listName (p, true)                                  val n = listName (p, true)
# Line 281  Line 283 
283                        true                        true
284                      end                      end
285                      else false                      else false
286          end handle Option => (RT.reset (); false)                  end
287            end handle Option => (Compile.reset (); false)
288                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
289      in      in
290          case BuildInitDG.build ginfo_nocore initgspec of          case BuildInitDG.build ginfo_nocore initgspec of
# Line 289  Line 292 
292            | NONE => false            | NONE => false
293      end      end
294    
295        fun reset () =
296            (Compile.reset ();
297             Parse.reset ())
298    
299      val make' = compile false      val make' = compile false
300      fun make () = make' NONE      fun make () = make' NONE
301      val deliver' = compile true      fun deliver' arg =
302            SafeIO.perform { openIt = fn () => (),
303                             closeIt = reset,
304                             work = fn () => compile true arg,
305                             cleanup = fn () => () }
306      fun deliver () = deliver' NONE      fun deliver () = deliver' NONE
     fun reset () =  
         (RecompPersstate.reset ();  
          RT.reset ();  
          Recomp.reset ();  
          Parse.reset ())  
307  end  end

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

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