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 327, Thu Jun 10 09:14:48 1999 UTC revision 329, Fri Jun 11 09:53:10 1999 UTC
# Line 6  Line 6 
6   *   *
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) = struct  functor BootstrapCompileFn (structure MachDepVC: MACHDEP_VC
10                                val os: SMLofNJ.SysInfo.os_kind) = struct
11    
12      structure EM = GenericVC.ErrorMsg      structure EM = GenericVC.ErrorMsg
13      structure E = GenericVC.Environment      structure E = GenericVC.Environment
# Line 31  Line 32 
32      fun recomp gp g = isSome (RT.group gp g)      fun recomp gp g = isSome (RT.group gp g)
33    
34      (* instantiate Stabilize... *)      (* instantiate Stabilize... *)
35      structure Stabilize = StabilizeFn (fun bn2statenv gp i =      structure Stabilize =
36                                             #1 (#stat (valOf (RT.bnode gp i)))          StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode gp i)))
37                                         val recomp = recomp)                                         val recomp = recomp)
38      (* ... and Parse *)      (* ... and Parse *)
39      structure Parse = ParseFn (structure Stabilize = Stabilize)      structure Parse = ParseFn (structure Stabilize = Stabilize)
40    
41      fun compile (keep_going, fnpolicy, pcmode, initgspec, maingspec, sflag) = let      fun compile { binroot, pcmodespec, initgspec, maingspec } = let
42    
43            val keep_going = EnvConfig.getSet StdConfig.keep_going NONE
44    
45            val ctxt = AbsPath.cwdContext ()
46    
47            val initgspec = AbsPath.native { context = ctxt, spec = initgspec }
48            val maingspec = AbsPath.native { context = ctxt, spec = maingspec }
49            val pcmodespec = AbsPath.native { context = ctxt, spec = pcmodespec }
50            val binroot = AbsPath.native { context = ctxt, spec = binroot }
51    
52            fun build_pcmode () = let
53                val s = AbsPath.openTextIn pcmodespec
54                fun loop l = let
55                    val line = TextIO.inputLine s
56                in
57                    if line = "" then PathConfig.hardwire l
58                    else case String.tokens Char.isSpace line of
59                        [a, s] => loop ((a, s) :: l)
60                      | _ => (Say.say [AbsPath.name pcmodespec,
61                                       ": malformed line (ignored)\n"];
62                              loop l)
63                end
64            in
65                loop [] before TextIO.closeIn s
66            end
67    
68            val pcmode = build_pcmode ()
69    
70            val fnpolicy =
71                FilenamePolicy.separate { root = binroot,
72                                          parentArc = "DOTDOT",
73                                          absArc = "ABSOLUTE" }
74                                        { arch = MachDepVC.architecture, os = os }
75    
76          val emptydyn = E.dynamicPart E.emptyEnv          val emptydyn = E.dynamicPart E.emptyEnv
77    
# Line 58  Line 92 
92              val primconf = Primitive.configuration [pspec]              val primconf = Primitive.configuration [pspec]
93          end          end
94    
95          val param = { primconf = primconf,          val param_nocore = { primconf = primconf,
96                        fnpolicy = fnpolicy,                        fnpolicy = fnpolicy,
97                        pcmode = pcmode,                        pcmode = pcmode,
98                        keep_going = keep_going,                        keep_going = keep_going,
# Line 68  Line 102 
102    
103          val groupreg = GroupReg.new ()          val groupreg = GroupReg.new ()
104          val errcons = EM.defaultConsumer ()          val errcons = EM.defaultConsumer ()
105          val ginfo = { param = param, groupreg = groupreg, errcons = errcons }          val ginfo_nocore = { param = param_nocore, groupreg = groupreg,
106                                 errcons = errcons }
107    
108          fun main_compile arg = let          fun main_compile arg = let
109              val { rts, core, pervasive, primitives, filepaths } = arg              val { rts, core, pervasive, primitives, filepaths } = arg
110    
111                val ovldR = GenericVC.Control.overloadKW
112                val savedOvld = !ovldR
113                val _ = ovldR := true
114    
115              (* here we build a new gp -- the one that uses the freshly              (* here we build a new gp -- the one that uses the freshly
116               * brewed pervasive env, core env, and primitives *)               * brewed pervasive env, core env, and primitives *)
117              fun rt n = valOf (RT.snode ginfo n)              val core = valOf (RT.snode ginfo_nocore core)
118                val corenv =  CoerceEnv.es2bs (#1 (#stat core))
119                val pervcorepids = PidSet.singleton (#2 (#stat core))
120    
121                (* The following is a bit of a hack (but corenv is a hack anyway):
122                 * As soon as we have core available, we have to patch the
123                 * ginfo to include the correct corenv (because virtually
124                 * everybody else needs access to corenv). *)
125                val param_justcore = { primconf = primconf,
126                                       fnpolicy = fnpolicy,
127                                       pcmode = pcmode,
128                                       keep_going = keep_going,
129                                       pervasive = E.emptyEnv,
130                                       corenv = corenv,
131                                       pervcorepids = pervcorepids }
132                val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
133                                       errcons = errcons }
134    
135                fun rt n = valOf (RT.snode ginfo_justcore n)
136              val rts = rt rts              val rts = rt rts
             val core = rt core  
137              val pervasive = rt pervasive              val pervasive = rt pervasive
138    
139              fun sn2pspec (name, n) = let              fun sn2pspec (name, n) = let
# Line 91  Line 147 
147    
148              val pspecs = map sn2pspec primitives              val pspecs = map sn2pspec primitives
149    
150                val _ = ovldR := savedOvld
151    
152              val param = { primconf = Primitive.configuration pspecs,              val param = { primconf = Primitive.configuration pspecs,
153                            fnpolicy = fnpolicy,                            fnpolicy = fnpolicy,
154                            pcmode = pcmode,                            pcmode = pcmode,
# Line 105  Line 163 
163                                               #2 (#sym pervasive),                                               #2 (#sym pervasive),
164                                               #2 (#stat core)]) }                                               #2 (#stat core)]) }
165          in          in
166              case Parse.parse param sflag maingspec of              case Parse.parse param (SOME true) maingspec of
167                  NONE => false                  NONE => NONE
168                | SOME (g, gp) => recomp gp g                | SOME (g, gp) =>
169          end handle Option => false (* to catch valOf failures in "rt" *)                      if recomp gp g then
170                            SOME { rtspid = PS.toHex (#2 (#stat rts)),
171                                   bootfiles =
172                                     map (fn x => (x, NONE)) filepaths @
173                                     MkBootList.group g }
174                        else NONE
175            end handle Option => NONE (* to catch valOf failures in "rt" *)
176      in      in
177          case BuildInitDG.build ginfo initgspec of          case BuildInitDG.build ginfo_nocore initgspec of
178              SOME x => main_compile x              SOME x => main_compile x
179            | NONE => false            | NONE => NONE
180      end      end
181  end  end

Legend:
Removed from v.327  
changed lines
  Added in v.329

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