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 370, Mon Jul 5 08:59:13 1999 UTC revision 448, Thu Oct 21 09:20:16 1999 UTC
# Line 13  Line 13 
13      val deliver' : string option -> bool      val deliver' : string option -> bool
14      val deliver : unit -> bool      val deliver : unit -> bool
15      val reset : unit -> unit      val reset : unit -> unit
16        val symval : string -> { get: unit -> int option, set: int option -> unit }
17  end = struct  end = struct
18    
19      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
# Line 25  Line 26 
26                                        val os = os)                                        val os = os)
27      structure P = OS.Path      structure P = OS.Path
28      structure F = OS.FileSys      structure F = OS.FileSys
29        structure BF = MachDepVC.Binfile
30    
31      (* Since the bootstrap compiler never executes any of the code      structure Compile = CompileFn (structure MachDepVC = MachDepVC
32       * it produces, we don't need any dynamic values.  Therefore,                                     fun compile_there _ = false)
      * 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 = ())  
   
     structure Recomp = RecompFn (structure PS = RecompPersstate)  
     structure RT = CompileGenericFn (structure CT = Recomp  
                                      val thinTraversal = false)  
33    
34      fun recomp gp g = isSome (RT.group gp g)      structure BFC = BfcFn (structure MachDepVC = MachDepVC)
35    
36      (* instantiate Stabilize... *)      (* instantiate Stabilize... *)
37      structure Stabilize =      structure Stabilize =
38          StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode gp i)))          StabilizeFn (fun destroy_state _ i = Compile.evict i
39                       fun warmup (i, p) = ()                       structure MachDepVC = MachDepVC
40                       val recomp = recomp                       fun recomp gp g = let
41                       val transfer_state = RecompPersstate.transfer_state)                           val { store, get } = BFC.new ()
42                             val { group, ... } =
43                                 Compile.newTraversal (fn _ => fn _ => (),
44                                                       store, g)
45                         in
46                             case group gp of
47                                 NONE => NONE
48                               | SOME _ => SOME get
49                         end
50                         val getII = Compile.getII)
51    
52      (* ... and Parse *)      (* ... and Parse *)
53      structure Parse = ParseFn (structure Stabilize = Stabilize      structure Parse = ParseFn (structure Stabilize = Stabilize
54                                 val pending = AutoLoad.getPending)                                 fun pending () = SymbolMap.empty)
55    
56      (* copying an input file to an output file safely... *)      (* copying an input file to an output file safely... *)
57      fun copyFile (oi, ci, oo, co, inp, outp, eof) (inf, outf) = let      fun copyFile (oi, ci, oo, co, inp, outp, eof) (inf, outf) = let
# Line 122  Line 121 
121                  end                  end
122                | _ => raise Fail "BootstrapCompile:listName: bad name"                | _ => raise Fail "BootstrapCompile:listName: bad name"
123    
124          val keep_going = EnvConfig.getSet StdConfig.keep_going NONE          val keep_going = #get StdConfig.keep_going ()
125    
126          val ctxt = SrcPath.cwdContext ()          val ctxt = SrcPath.cwdContext ()
127    
# Line 149  Line 148 
148              { primconf = primconf,              { primconf = primconf,
149                fnpolicy = fnpolicy,                fnpolicy = fnpolicy,
150                pcmode = pcmode,                pcmode = pcmode,
151                symenv = SSV.env,                symval = SSV.symval,
152                keep_going = keep_going,                keep_going = keep_going,
153                pervasive = pervasive,                pervasive = pervasive,
154                corenv = corenv,                corenv = corenv,
# Line 178  Line 177 
177              val ovldR = GenericVC.Control.overloadKW              val ovldR = GenericVC.Control.overloadKW
178              val savedOvld = !ovldR              val savedOvld = !ovldR
179              val _ = ovldR := true              val _ = ovldR := true
180                val sbnode = Compile.newSbnodeTraversal ()
181    
182              (* here we build a new gp -- the one that uses the freshly              (* here we build a new gp -- the one that uses the freshly
183               * brewed pervasive env, core env, and primitives *)               * brewed pervasive env, core env, and primitives *)
184              val core = valOf (RT.sbnode ginfo_nocore core)              val core = valOf (sbnode ginfo_nocore core)
185              val corenv =  CoerceEnv.es2bs (#1 (#stat core))              val corenv =  CoerceEnv.es2bs (#statenv (#ii core) ())
186              val core_sym = #1 (#sym core)              val core_sym = #symenv (#ii core) ()
187    
188              (* 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):
189               * 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 193 
193              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
194                                     errcons = errcons }                                     errcons = errcons }
195    
196              fun rt n = valOf (RT.sbnode ginfo_justcore n)              fun rt n = valOf (sbnode ginfo_justcore n)
197              val rts = rt rts              val rts = rt rts
198              val pervasive = rt pervasive              val pervasive = rt pervasive
199    
200              fun sn2pspec (name, n) = let              fun sn2pspec (name, n) = let
201                  val { stat = (s, sp), sym = (sy, syp), ctxt, bfc } = rt n                  val { ii = { statenv, symenv, statpid, sympid }, ctxt } = rt n
202                  val env =                  val env =
203                      E.mkenv { static = s, symbolic = sy, dynamic = emptydyn }                      E.mkenv { static = statenv (),
204                  val pidInfo = { statpid = sp, sympid = syp, ctxt = ctxt }                                symbolic = symenv (),
205                                  dynamic = emptydyn }
206                    val pidInfo =
207                        { statpid = statpid, sympid = sympid, ctxt = ctxt }
208              in              in
209                  { name = name, env = env, pidInfo = pidInfo }                  { name = name, env = env, pidInfo = pidInfo }
210              end              end
# Line 210  Line 213 
213    
214              val _ = ovldR := savedOvld              val _ = ovldR := savedOvld
215    
216              (* This is a hack but must be done for both the symbolic              (* The following is a hack but must be done for both the symbolic
217               * and later the dynamic part of the core environment:               * and later the dynamic part of the core environment:
218               * we must include these parts in the pervasive env. *)               * we must include these parts in the pervasive env. *)
219              val perv_sym = E.layerSymbolic (#1 (#sym pervasive), core_sym)              val perv_sym = E.layerSymbolic (#symenv (#ii pervasive) (),
220                                                core_sym)
221    
222              val param =              val param =
223                  mkParam { primconf = Primitive.configuration pspecs,                  mkParam { primconf = Primitive.configuration pspecs,
224                            pervasive = E.mkenv { static = #1 (#stat pervasive),                            pervasive = E.mkenv { static =
225                                                     #statenv (#ii pervasive) (),
226                                                  symbolic = perv_sym,                                                  symbolic = perv_sym,
227                                                  dynamic = emptydyn },                                                  dynamic = emptydyn },
228                            pervcorepids =                            pervcorepids =
229                              PidSet.addList (PidSet.empty,                              PidSet.addList (PidSet.empty,
230                                              [#2 (#stat pervasive),                                              [#statpid (#ii pervasive),
231                                               #2 (#sym pervasive),                                               #sympid (#ii pervasive),
232                                               #2 (#stat core)]) }                                               #statpid (#ii core)]) }
233                          { corenv = corenv }                          { corenv = corenv }
234              val stab =              val stab =
235                  if deliver then SOME true else NONE                  if deliver then SOME true else NONE
236          in          in
237              case Parse.parse NONE param stab maingspec of              case Parse.parse NONE param stab maingspec of
238                  NONE => false                  NONE => false
239                | SOME (g, gp) =>                | SOME (g, gp) => let
240                      if recomp gp g then let                      fun store _ = ()
241                          val rtspid = PS.toHex (#2 (#stat rts))                      val { group = recomp, ... } =
242                            Compile.newTraversal (fn _ => fn _ => (), store, g)
243                    in
244                        if isSome (recomp gp) then let
245                            val rtspid = PS.toHex (#statpid (#ii rts))
246                          fun writeList s = let                          fun writeList s = let
247                              fun add ((p, flag), l) = let                              fun add ((p, flag), l) = let
248                                  val n = listName (p, true)                                  val n = listName (p, true)
# Line 276  Line 285 
285                        true                        true
286                      end                      end
287                      else false                      else false
288          end handle Option => (RT.reset (); false)                  end
289            end handle Option => (Compile.reset (); false)
290                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
291      in      in
292          case BuildInitDG.build ginfo_nocore initgspec of          case BuildInitDG.build ginfo_nocore initgspec of
# Line 284  Line 294 
294            | NONE => false            | NONE => false
295      end      end
296    
297        fun reset () =
298            (Compile.reset ();
299             Parse.reset ())
300    
301      val make' = compile false      val make' = compile false
302      fun make () = make' NONE      fun make () = make' NONE
303      val deliver' = compile true      fun deliver' arg =
304            SafeIO.perform { openIt = fn () => (),
305                             closeIt = reset,
306                             work = fn () => compile true arg,
307                             cleanup = fn () => () }
308      fun deliver () = deliver' NONE      fun deliver () = deliver' NONE
309      fun reset () =      val symval = SSV.symval
         (RecompPersstate.reset ();  
          RT.resetAll ();  
          Recomp.reset ();  
          Parse.reset ())  
310  end  end

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

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