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 335, Thu Jun 17 08:21:08 1999 UTC revision 356, Sun Jun 27 11:51:16 1999 UTC
# Line 15  Line 15 
15      structure BE = GenericVC.BareEnvironment      structure BE = GenericVC.BareEnvironment
16      structure PS = GenericVC.PersStamps      structure PS = GenericVC.PersStamps
17      structure CoerceEnv = GenericVC.CoerceEnv      structure CoerceEnv = GenericVC.CoerceEnv
18        structure SSV = SpecificSymValFn (structure MachDepVC = MachDepVC
19                                          val os = os)
20    
21      (* Since the bootstrap compiler never executes any of the code      (* Since the bootstrap compiler never executes any of the code
22       * it produces, we don't need any dynamic values.  Therefore,       * it produces, we don't need any dynamic values.  Therefore,
# Line 38  Line 40 
40      (* ... and Parse *)      (* ... and Parse *)
41      structure Parse = ParseFn (structure Stabilize = Stabilize)      structure Parse = ParseFn (structure Stabilize = Stabilize)
42    
43      fun compile { binroot, pcmodespec, initgspec, maingspec } = let      fun compile { binroot, pcmodespec, initgspec, maingspec, stabilize } = let
44    
45          val keep_going = EnvConfig.getSet StdConfig.keep_going NONE          val keep_going = EnvConfig.getSet StdConfig.keep_going NONE
46    
47          val ctxt = AbsPath.cwdContext ()          val ctxt = SrcPath.cwdContext ()
48    
49          val initgspec = AbsPath.native { context = ctxt, spec = initgspec }          val pidfile = OS.Path.joinDirFile { dir = binroot, file = "RTPID" }
50          val maingspec = AbsPath.native { context = ctxt, spec = maingspec }          val listfile = OS.Path.joinDirFile { dir = binroot, file = "BINLIST" }
         val pcmodespec = AbsPath.native { context = ctxt, spec = pcmodespec }  
         val binroot = AbsPath.native { context = ctxt, spec = binroot }  
51    
52          fun build_pcmode () = let          val pcmode = let
53              val s = AbsPath.openTextIn pcmodespec              fun work s = let
54              fun loop l = let              fun loop l = let
55                  val line = TextIO.inputLine s                  val line = TextIO.inputLine s
56              in              in
57                  if line = "" then PathConfig.hardwire l                  if line = "" then PathConfig.hardwire l
58                  else case String.tokens Char.isSpace line of                  else case String.tokens Char.isSpace line of
59                      [a, s] => loop ((a, s) :: l)                      [a, s] => loop ((a, s) :: l)
60                    | _ => (Say.say [AbsPath.name pcmodespec,                        | _ => (Say.say [pcmodespec,
61                                     ": malformed line (ignored)\n"];                                     ": malformed line (ignored)\n"];
62                            loop l)                            loop l)
63              end              end
64          in          in
65              loop [] before TextIO.closeIn s                  loop []
66          end          end
67            in
68                SafeIO.perform { openIt = fn () => TextIO.openIn pcmodespec,
69                                 closeIt = TextIO.closeIn,
70                                 work = work,
71                                 cleanup = fn () => () }
72            end
73    
74            fun stdpath s = SrcPath.standard pcmode { context = ctxt, spec = s }
75    
76          val pcmode = build_pcmode ()          val initgspec = stdpath initgspec
77            val maingspec = stdpath maingspec
78    
79          val fnpolicy =          val fnpolicy =
80              FilenamePolicy.separate { root = binroot,              FilenamePolicy.separate binroot
                                       parentArc = "DOTDOT",  
                                       absArc = "ABSOLUTE" }  
81                                      { arch = MachDepVC.architecture, os = os }                                      { arch = MachDepVC.architecture, os = os }
82    
83            fun mkParam { primconf, pervasive, pervcorepids } { corenv } =
84                { primconf = primconf,
85                  fnpolicy = fnpolicy,
86                  pcmode = pcmode,
87                  symenv = SSV.env,
88                  keep_going = keep_going,
89                  pervasive = pervasive,
90                  corenv = corenv,
91                  pervcorepids = pervcorepids }
92    
93          val emptydyn = E.dynamicPart E.emptyEnv          val emptydyn = E.dynamicPart E.emptyEnv
94    
95          (* first, build an initial GeneralParam.info, so we can          (* first, build an initial GeneralParam.info, so we can
# Line 92  Line 109 
109              val primconf = Primitive.configuration [pspec]              val primconf = Primitive.configuration [pspec]
110          end          end
111    
112          val param_nocore = { primconf = primconf,          val mkInitParam = mkParam { primconf = primconf,
                              fnpolicy = fnpolicy,  
                              pcmode = pcmode,  
                              keep_going = keep_going,  
113                               pervasive = E.emptyEnv,                               pervasive = E.emptyEnv,
                              corenv = BE.staticPart BE.emptyEnv,  
114                               pervcorepids = PidSet.empty }                               pervcorepids = PidSet.empty }
115    
116            val param_nocore = mkInitParam { corenv = BE.staticPart BE.emptyEnv }
117    
118          val groupreg = GroupReg.new ()          val groupreg = GroupReg.new ()
119          val errcons = EM.defaultConsumer ()          val errcons = EM.defaultConsumer ()
120          val ginfo_nocore = { param = param_nocore, groupreg = groupreg,          val ginfo_nocore = { param = param_nocore, groupreg = groupreg,
# Line 116  Line 131 
131               * brewed pervasive env, core env, and primitives *)               * brewed pervasive env, core env, and primitives *)
132              val core = valOf (RT.snode ginfo_nocore core)              val core = valOf (RT.snode ginfo_nocore core)
133              val corenv =  CoerceEnv.es2bs (#1 (#stat core))              val corenv =  CoerceEnv.es2bs (#1 (#stat core))
134              (* even though we have a pid for the core, we can't use it              val core_sym = #1 (#sym core)
              * (otherwise we would invalidate earlier compilation results) *)  
             val pervcorepids = PidSet.empty  
135    
136              (* 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):
137               * As soon as we have core available, we have to patch the               * As soon as we have core available, we have to patch the
138               * ginfo to include the correct corenv (because virtually               * ginfo to include the correct corenv (because virtually
139               * everybody else needs access to corenv). *)               * everybody else needs access to corenv). *)
140              val param_justcore = { primconf = primconf,              val param_justcore = mkInitParam { corenv = corenv }
                                    fnpolicy = fnpolicy,  
                                    pcmode = pcmode,  
                                    keep_going = keep_going,  
                                    pervasive = E.emptyEnv,  
                                    corenv = corenv,  
                                    pervcorepids = pervcorepids }  
141              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
142                                     errcons = errcons }                                     errcons = errcons }
143    
# Line 151  Line 158 
158    
159              val _ = ovldR := savedOvld              val _ = ovldR := savedOvld
160    
161              val param = { primconf = Primitive.configuration pspecs,              (* This is a hack but must be done for both the symbolic
162                            fnpolicy = fnpolicy,               * and later the dynamic part of the core environment:
163                            pcmode = pcmode,               * we must include these parts in the pervasive env. *)
164                            keep_going = keep_going,              val perv_sym = E.layerSymbolic (#1 (#sym pervasive), core_sym)
165    
166                val param =
167                    mkParam { primconf = Primitive.configuration pspecs,
168                            pervasive = E.mkenv { static = #1 (#stat pervasive),                            pervasive = E.mkenv { static = #1 (#stat pervasive),
169                                                  symbolic = #1 (#sym pervasive),                                                  symbolic = perv_sym,
170                                                  dynamic = emptydyn },                                                  dynamic = emptydyn },
                           corenv = CoerceEnv.es2bs (#1 (#stat core)),  
171                            pervcorepids =                            pervcorepids =
172                              PidSet.addList (PidSet.empty,                              PidSet.addList (PidSet.empty,
173                                              [#2 (#stat pervasive),                                              [#2 (#stat pervasive),
174                                               #2 (#sym pervasive),                                               #2 (#sym pervasive),
175                                               #2 (#stat core)]) }                                               #2 (#stat core)]) }
176                            { corenv = corenv }
177                val stableflag = if stabilize then SOME true else NONE
178          in          in
179              case Parse.parse param NONE maingspec of              case Parse.parse NONE param stableflag maingspec of
180                  NONE => NONE                  NONE => false
181                | SOME (g, gp) =>                | SOME (g, gp) =>
182                      if recomp gp g then                      if recomp gp g then let
183                          SOME { rtspid = PS.toHex (#2 (#stat rts)),                          val rtspid = PS.toHex (#2 (#stat rts))
184                                 bootfiles =                          val bootfiles =
185                                   map (fn x => (x, NONE)) binpaths @                                   map (fn x => (x, NONE)) binpaths @
186                                   MkBootList.group g }                              MkBootList.group g
187                      else NONE                          fun writeList s = let
188          end handle Option => (RT.clearFailures (); NONE)                              fun offset NONE = ["\n"]
189                                  | offset (SOME i) = ["@", Int.toString i, "\n"]
190                                fun showBootFile (p, off) =
191                                    TextIO.output (s, concat (p :: offset off))
192                            in
193                                app showBootFile bootfiles
194                            end
195                        in
196                            Say.say ["Runtime System PID is: ", rtspid, "\n"];
197                            SafeIO.perform { openIt = fn () =>
198                                               AutoDir.openTextOut pidfile,
199                                             closeIt = TextIO.closeOut,
200                                             work = fn s =>
201                                               TextIO.output (s, rtspid ^ "\n"),
202                                             cleanup = fn () =>
203                                               OS.FileSys.remove pidfile
204                                               handle _ => () };
205                            SafeIO.perform { openIt = fn () =>
206                                               AutoDir.openTextOut listfile,
207                                             closeIt = TextIO.closeOut,
208                                             work = writeList,
209                                             cleanup = fn () =>
210                                               OS.FileSys.remove listfile
211                                               handle _ => () };
212                            true
213                        end
214                        else false
215            end handle Option => (RT.reset (); false)
216                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
217      in      in
218          case BuildInitDG.build ginfo_nocore initgspec of          case BuildInitDG.build ginfo_nocore initgspec of
219              SOME x => main_compile x              SOME x => main_compile x
220            | NONE => NONE            | NONE => false
221      end      end
222  end  end

Legend:
Removed from v.335  
changed lines
  Added in v.356

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