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 355, Sat Jun 26 13:17:30 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))
             (* even though we have a pid for the core, we can't use it  
              * (otherwise we would invalidate earlier compilation results) *)  
             val pervcorepids = PidSet.empty  
134    
135              (* 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):
136               * As soon as we have core available, we have to patch the               * As soon as we have core available, we have to patch the
137               * ginfo to include the correct corenv (because virtually               * ginfo to include the correct corenv (because virtually
138               * everybody else needs access to corenv). *)               * everybody else needs access to corenv). *)
139              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 }  
140              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
141                                     errcons = errcons }                                     errcons = errcons }
142    
# Line 151  Line 157 
157    
158              val _ = ovldR := savedOvld              val _ = ovldR := savedOvld
159    
160              val param = { primconf = Primitive.configuration pspecs,              val param =
161                            fnpolicy = fnpolicy,                  mkParam { primconf = Primitive.configuration pspecs,
                           pcmode = pcmode,  
                           keep_going = keep_going,  
162                            pervasive = E.mkenv { static = #1 (#stat pervasive),                            pervasive = E.mkenv { static = #1 (#stat pervasive),
163                                                  symbolic = #1 (#sym pervasive),                                                  symbolic = #1 (#sym pervasive),
164                                                  dynamic = emptydyn },                                                  dynamic = emptydyn },
                           corenv = CoerceEnv.es2bs (#1 (#stat core)),  
165                            pervcorepids =                            pervcorepids =
166                              PidSet.addList (PidSet.empty,                              PidSet.addList (PidSet.empty,
167                                              [#2 (#stat pervasive),                                              [#2 (#stat pervasive),
168                                               #2 (#sym pervasive),                                               #2 (#sym pervasive),
169                                               #2 (#stat core)]) }                                               #2 (#stat core)]) }
170                            { corenv = corenv }
171                val stableflag = if stabilize then SOME true else NONE
172          in          in
173              case Parse.parse param NONE maingspec of              case Parse.parse NONE param stableflag maingspec of
174                  NONE => NONE                  NONE => false
175                | SOME (g, gp) =>                | SOME (g, gp) =>
176                      if recomp gp g then                      if recomp gp g then let
177                          SOME { rtspid = PS.toHex (#2 (#stat rts)),                          val rtspid = PS.toHex (#2 (#stat rts))
178                                 bootfiles =                          val bootfiles =
179                                   map (fn x => (x, NONE)) binpaths @                                   map (fn x => (x, NONE)) binpaths @
180                                   MkBootList.group g }                              MkBootList.group g
181                      else NONE                          fun writeList s = let
182          end handle Option => (RT.clearFailures (); NONE)                              fun offset NONE = ["\n"]
183                                  | offset (SOME i) = ["@", Int.toString i, "\n"]
184                                fun showBootFile (p, off) =
185                                    TextIO.output (s, concat (p :: offset off))
186                            in
187                                app showBootFile bootfiles
188                            end
189                        in
190                            Say.say ["Runtime System PID is: ", rtspid, "\n"];
191                            SafeIO.perform { openIt = fn () =>
192                                               AutoDir.openTextOut pidfile,
193                                             closeIt = TextIO.closeOut,
194                                             work = fn s =>
195                                               TextIO.output (s, rtspid ^ "\n"),
196                                             cleanup = fn () =>
197                                               OS.FileSys.remove pidfile
198                                               handle _ => () };
199                            SafeIO.perform { openIt = fn () =>
200                                               AutoDir.openTextOut listfile,
201                                             closeIt = TextIO.closeOut,
202                                             work = writeList,
203                                             cleanup = fn () =>
204                                               OS.FileSys.remove listfile
205                                               handle _ => () };
206                            true
207                        end
208                        else false
209            end handle Option => (RT.reset (); false)
210                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
211      in      in
212          case BuildInitDG.build ginfo_nocore initgspec of          case BuildInitDG.build ginfo_nocore initgspec of
213              SOME x => main_compile x              SOME x => main_compile x
214            | NONE => NONE            | NONE => false
215      end      end
216  end  end

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

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