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 364, Fri Jul 2 07:33:12 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 = ())  
33    
34      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)  
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                       val getPid = RecompPersstate.pid_fetch_sml                       structure MachDepVC = MachDepVC
40                       fun warmup (i, p) = ()                       fun recomp gp g = let
41                       val recomp = recomp                           val { store, get } = BFC.new ()
42                       val transfer_state = RecompPersstate.transfer_state)                           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      fun cpTextStreams (ins, outs) = let      (* copying an input file to an output file safely... *)
57        fun copyFile (oi, ci, oo, co, inp, outp, eof) (inf, outf) = let
58            fun workIn is = let
59                fun workOut os = let
60          val N = 4096          val N = 4096
61          fun cp () =                  fun loop () =
62              if TextIO.endOfStream ins then ()                      if eof is then () else (outp (os, inp (is, N)); loop ())
63              else (TextIO.output (outs,              in
64                                   TextIO.inputN (ins, N));                  loop ()
65                    cp ())              end
66      in          in
67          cp ()              SafeIO.perform { openIt = fn () => oo outf,
68      end                               closeIt = co,
69                                 work = workOut,
     fun openTextStreams (inf, outf) () =  
         (TextIO.openIn inf, AutoDir.openTextOut outf)  
     fun closeTextStreams (ins, outs) =  
         (TextIO.closeIn ins; TextIO.closeOut outs)  
   
     fun copyFile (inf, outf) =  
         SafeIO.perform { openIt = openTextStreams (inf, outf),  
                          closeIt = closeTextStreams,  
                          work = cpTextStreams,  
70                           cleanup = fn () =>                           cleanup = fn () =>
71                              (F.remove outf handle _ => ()) }                              (F.remove outf handle _ => ()) }
72            end
73        in
74            SafeIO.perform { openIt = fn () => oi inf,
75                             closeIt = ci,
76                             work = workIn,
77                             cleanup = fn () => () }
78        end
79    
80        val copyTextFile =
81            copyFile (TextIO.openIn, TextIO.closeIn,
82                      AutoDir.openTextOut, TextIO.closeOut,
83                      TextIO.inputN, TextIO.output, TextIO.endOfStream)
84    
85        val copyBinFile =
86            copyFile (BinIO.openIn, BinIO.closeIn,
87                      AutoDir.openBinOut, BinIO.closeOut,
88                      BinIO.inputN, BinIO.output, BinIO.endOfStream)
89    
90      fun compile deliver dbopt = let      fun compile deliver dbopt = let
91    
# Line 100  Line 110 
110                              P.toString { isAbs = false, vol = "",                              P.toString { isAbs = false, vol = "",
111                                           arcs = bootdir :: arc1 :: arcn }                                           arcs = bootdir :: arc1 :: arcn }
112                      in                      in
113                          copyFile (p, bootpath)                          copyBinFile (p, bootpath)
114                      end                      end
115                  in                  in
116                      if copy andalso arc0 = bindir then doCopy () else ();                      if copy andalso arc0 = bindir then doCopy () else ();
# Line 111  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 138  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 167  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 182  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 } = 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 199  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 243  Line 263 
263                              app show bootstrings                              app show bootstrings
264                          end                          end
265                      in                      in
                       Say.say ["Runtime System PID is: ", rtspid, "\n"];  
266                        if deliver then                        if deliver then
267                         (SafeIO.perform { openIt = fn () =>                         (SafeIO.perform { openIt = fn () =>
268                                             AutoDir.openTextOut pidfile,                                             AutoDir.openTextOut pidfile,
# Line 260  Line 279 
279                                           cleanup = fn () =>                                           cleanup = fn () =>
280                                             OS.FileSys.remove listfile                                             OS.FileSys.remove listfile
281                                             handle _ => () };                                             handle _ => () };
282                          copyFile (SrcPath.osstring initgspec, cmifile))                          copyTextFile (SrcPath.osstring initgspec, cmifile);
283                            Say.say ["Runtime System PID is: ", rtspid, "\n"])
284                        else ();                        else ();
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 273  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 ())  
310  end  end

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

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