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 336, Thu Jun 17 09:23:20 1999 UTC revision 357, Mon Jun 28 08:46:30 1999 UTC
# Line 7  Line 7 
7   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)   * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
8   *)   *)
9  functor BootstrapCompileFn (structure MachDepVC: MACHDEP_VC  functor BootstrapCompileFn (structure MachDepVC: MACHDEP_VC
10                              val os: SMLofNJ.SysInfo.os_kind) = struct                              val os: SMLofNJ.SysInfo.os_kind) :> sig
11    
12        val compile :
13            { dirbase: string,
14              pcmodespec: string,
15              initgspec: string,
16              maingspec: string,
17              stabilize: bool }
18            -> bool
19    
20    end = struct
21    
22      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
23      structure E = GenericVC.Environment      structure E = GenericVC.Environment
# Line 36  Line 46 
46      (* instantiate Stabilize... *)      (* instantiate Stabilize... *)
47      structure Stabilize =      structure Stabilize =
48          StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode gp i)))          StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode gp i)))
49                         val getPid = RecompPersstate.pid_fetch_sml
50                         fun warmup (i, p) = ()
51                       val recomp = recomp)                       val recomp = recomp)
52      (* ... and Parse *)      (* ... and Parse *)
53      structure Parse = ParseFn (structure Stabilize = Stabilize)      structure Parse = ParseFn (structure Stabilize = Stabilize)
54    
55      fun compile { binroot, pcmodespec, initgspec, maingspec } = let      fun compile { dirbase, pcmodespec, initgspec, maingspec, stabilize } = let
56    
57            val arch = MachDepVC.architecture
58            val osname = FilenamePolicy.kind2name os
59            val bindir = concat [dirbase, ".bin.", arch, "-", osname]
60            val bootdir = concat [dirbase, ".boot.", arch, "-", osname]
61    
62          val keep_going = EnvConfig.getSet StdConfig.keep_going NONE          val keep_going = EnvConfig.getSet StdConfig.keep_going NONE
63    
64          val ctxt = AbsPath.cwdContext ()          val ctxt = SrcPath.cwdContext ()
65    
66          val initgspec = AbsPath.native { context = ctxt, spec = initgspec }          val pidfile = OS.Path.joinDirFile { dir = bootdir, file = "RTPID" }
67          val maingspec = AbsPath.native { context = ctxt, spec = maingspec }          val listfile = OS.Path.joinDirFile { dir = bootdir, file = "BINLIST" }
         val pcmodespec = AbsPath.native { context = ctxt, spec = pcmodespec }  
         val binroot = AbsPath.native { context = ctxt, spec = binroot }  
68    
69          fun build_pcmode () = let          val pcmode = let
70              val s = AbsPath.openTextIn pcmodespec              fun work s = let
71              fun loop l = let              fun loop l = let
72                  val line = TextIO.inputLine s                  val line = TextIO.inputLine s
73              in              in
74                  if line = "" then PathConfig.hardwire l                  if line = "" then PathConfig.hardwire l
75                  else case String.tokens Char.isSpace line of                  else case String.tokens Char.isSpace line of
76                      [a, s] => loop ((a, s) :: l)                      [a, s] => loop ((a, s) :: l)
77                    | _ => (Say.say [AbsPath.name pcmodespec,                        | _ => (Say.say [pcmodespec,
78                                     ": malformed line (ignored)\n"];                                     ": malformed line (ignored)\n"];
79                            loop l)                            loop l)
80              end              end
81          in          in
82              loop [] before TextIO.closeIn s                  loop []
83                end
84            in
85                SafeIO.perform { openIt = fn () => TextIO.openIn pcmodespec,
86                                 closeIt = TextIO.closeIn,
87                                 work = work,
88                                 cleanup = fn () => () }
89          end          end
90    
91          val pcmode = build_pcmode ()          fun stdpath s = SrcPath.standard pcmode { context = ctxt, spec = s }
92    
93            val initgspec = stdpath initgspec
94            val maingspec = stdpath maingspec
95    
96            val initfnpolicy =
97                FilenamePolicy.separate { bindir = bootdir, bootdir = bootdir }
98                    { arch = arch, os = os }
99    
100            val mainfnpolicy =
101                FilenamePolicy.separate { bindir = bindir, bootdir = bootdir }
102                    { arch = arch, os = os }
103    
104          val fnpolicy =          fun mkParam { primconf, pervasive, pervcorepids, fnpolicy }
105              FilenamePolicy.separate { root = binroot,                      { corenv } =
106                                        parentArc = "DOTDOT",              { primconf = primconf,
107                                        absArc = "ABSOLUTE" }                fnpolicy = fnpolicy,
108                                      { arch = MachDepVC.architecture, os = os }                pcmode = pcmode,
109                  symenv = SSV.env,
110                  keep_going = keep_going,
111                  pervasive = pervasive,
112                  corenv = corenv,
113                  pervcorepids = pervcorepids }
114    
115          val emptydyn = E.dynamicPart E.emptyEnv          val emptydyn = E.dynamicPart E.emptyEnv
116    
# Line 94  Line 131 
131              val primconf = Primitive.configuration [pspec]              val primconf = Primitive.configuration [pspec]
132          end          end
133    
134          val param_nocore = { primconf = primconf,          val mkInitParam = mkParam { primconf = primconf,
                              fnpolicy = fnpolicy,  
                              pcmode = pcmode,  
                              symenv = SSV.env,  
                              keep_going = keep_going,  
135                               pervasive = E.emptyEnv,                               pervasive = E.emptyEnv,
136                               corenv = BE.staticPart BE.emptyEnv,                                      pervcorepids = PidSet.empty,
137                               pervcorepids = PidSet.empty }                                      fnpolicy = initfnpolicy }
138    
139            val param_nocore = mkInitParam { corenv = BE.staticPart BE.emptyEnv }
140    
141          val groupreg = GroupReg.new ()          val groupreg = GroupReg.new ()
142          val errcons = EM.defaultConsumer ()          val errcons = EM.defaultConsumer ()
# Line 119  Line 154 
154               * brewed pervasive env, core env, and primitives *)               * brewed pervasive env, core env, and primitives *)
155              val core = valOf (RT.snode ginfo_nocore core)              val core = valOf (RT.snode ginfo_nocore core)
156              val corenv =  CoerceEnv.es2bs (#1 (#stat core))              val corenv =  CoerceEnv.es2bs (#1 (#stat core))
157              (* 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  
158    
159              (* 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):
160               * As soon as we have core available, we have to patch the               * As soon as we have core available, we have to patch the
161               * ginfo to include the correct corenv (because virtually               * ginfo to include the correct corenv (because virtually
162               * everybody else needs access to corenv). *)               * everybody else needs access to corenv). *)
163              val param_justcore = { primconf = primconf,              val param_justcore = mkInitParam { corenv = corenv }
                                    fnpolicy = fnpolicy,  
                                    pcmode = pcmode,  
                                    symenv = SSV.env,  
                                    keep_going = keep_going,  
                                    pervasive = E.emptyEnv,  
                                    corenv = corenv,  
                                    pervcorepids = pervcorepids }  
164              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,              val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
165                                     errcons = errcons }                                     errcons = errcons }
166    
# Line 155  Line 181 
181    
182              val _ = ovldR := savedOvld              val _ = ovldR := savedOvld
183    
184              val param = { primconf = Primitive.configuration pspecs,              (* This is a hack but must be done for both the symbolic
185                            fnpolicy = fnpolicy,               * and later the dynamic part of the core environment:
186                            pcmode = pcmode,               * we must include these parts in the pervasive env. *)
187                            symenv = SSV.env,              val perv_sym = E.layerSymbolic (#1 (#sym pervasive), core_sym)
188                            keep_going = keep_going,  
189                val param =
190                    mkParam { primconf = Primitive.configuration pspecs,
191                            pervasive = E.mkenv { static = #1 (#stat pervasive),                            pervasive = E.mkenv { static = #1 (#stat pervasive),
192                                                  symbolic = #1 (#sym pervasive),                                                  symbolic = perv_sym,
193                                                  dynamic = emptydyn },                                                  dynamic = emptydyn },
                           corenv = CoerceEnv.es2bs (#1 (#stat core)),  
194                            pervcorepids =                            pervcorepids =
195                              PidSet.addList (PidSet.empty,                              PidSet.addList (PidSet.empty,
196                                              [#2 (#stat pervasive),                                              [#2 (#stat pervasive),
197                                               #2 (#sym pervasive),                                               #2 (#sym pervasive),
198                                               #2 (#stat core)]) }                                               #2 (#stat core)]),
199                              fnpolicy = mainfnpolicy }
200                            { corenv = corenv }
201                val stableflag = if stabilize then SOME true else NONE
202          in          in
203              case Parse.parse param NONE maingspec of              case Parse.parse NONE param stableflag maingspec of
204                  NONE => NONE                  NONE => false
205                | SOME (g, gp) =>                | SOME (g, gp) =>
206                      if recomp gp g then                      if recomp gp g then let
207                          SOME { rtspid = PS.toHex (#2 (#stat rts)),                          val rtspid = PS.toHex (#2 (#stat rts))
208                                 bootfiles =                          val bootfiles =
209                                   map (fn x => (x, NONE)) binpaths @                                   map (fn x => (x, NONE)) binpaths @
210                                   MkBootList.group g }                              MkBootList.group g
211                      else NONE                          fun writeList s = let
212          end handle Option => (RT.clearFailures (); NONE)                              fun offset NONE = ["\n"]
213                                  | offset (SOME i) = ["@", Int.toString i, "\n"]
214                                fun showBootFile (p, off) =
215                                    TextIO.output (s, concat (p :: offset off))
216                            in
217                                app showBootFile bootfiles
218                            end
219                        in
220                            Say.say ["Runtime System PID is: ", rtspid, "\n"];
221                            SafeIO.perform { openIt = fn () =>
222                                               AutoDir.openTextOut pidfile,
223                                             closeIt = TextIO.closeOut,
224                                             work = fn s =>
225                                               TextIO.output (s, rtspid ^ "\n"),
226                                             cleanup = fn () =>
227                                               OS.FileSys.remove pidfile
228                                               handle _ => () };
229                            SafeIO.perform { openIt = fn () =>
230                                               AutoDir.openTextOut listfile,
231                                             closeIt = TextIO.closeOut,
232                                             work = writeList,
233                                             cleanup = fn () =>
234                                               OS.FileSys.remove listfile
235                                               handle _ => () };
236                            true
237                        end
238                        else false
239            end handle Option => (RT.reset (); false)
240                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
241      in      in
242          case BuildInitDG.build ginfo_nocore initgspec of          case BuildInitDG.build ginfo_nocore initgspec of
243              SOME x => main_compile x              SOME x => main_compile x
244            | NONE => NONE            | NONE => false
245      end      end
246  end  end

Legend:
Removed from v.336  
changed lines
  Added in v.357

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