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/branches/SMLNJ/src/compiler/TopLevel/bootstrap/boot.sml
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/compiler/TopLevel/bootstrap/boot.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 142, Mon Sep 7 21:37:09 1998 UTC revision 143, Mon Sep 7 21:46:44 1998 UTC
# Line 5  Line 5 
5   *   completely redone by M.Blume (5/1998)   *   completely redone by M.Blume (5/1998)
6   *)   *)
7  signature BOOTENV = sig  signature BOOTENV = sig
8      type env = Environment.environment      val bootEnv: unit -> Environment.environment
     val bootEnv: unit -> env  
9  end  end
10    
11  functor BootEnvF (structure VC: VISCOMP  functor BootEnvF (structure VC: VISCOMP
12                    val setRetargetPervStatEnv: CMStaticEnv.staticEnv -> unit                    val setRetargetPervStatEnv: CMStaticEnv.staticEnv -> unit
13                    val cmbmake: string -> unit): BOOTENV = struct                    val cmbmake: string -> unit) :> BOOTENV = struct
14    
15      exception BootFailure      exception BootFailure
16    
17        structure Env = Environment
18      structure BF = VC.Binfile      structure BF = VC.Binfile
19      structure CMS = CMStaticEnv      structure CMS = CMStaticEnv
20      structure SE = StaticEnv      structure SE = StaticEnv
21      structure DynE = DynamicEnv      structure DynE = DynamicEnv
     structure SymE = SymbolicEnv  
22      structure PS = PersStamps      structure PS = PersStamps
23    
24      type env = Environment.environment      datatype envrequest = BARE | NORMAL | FULL
25    
26      fun say s = (Control.Print.say s; Control.Print.flush ())      fun say s = (Control.Print.say s; Control.Print.flush ())
27      fun die s = (say s; raise BootFailure)      fun die s = (say s; raise BootFailure)
# Line 35  Line 34 
34    
35      (* get the dynamic environment from the runtime system *)      (* get the dynamic environment from the runtime system *)
36      local      local
37          datatype runDynEnv =          structure U = Unsafe
             NILrde  
           | CONSrde of Word8Vector.vector * Unsafe.Object.object * runDynEnv  
   
         val a_pstruct: runDynEnv ref = Unsafe.cast Unsafe.pStruct  
38    
39          (* Here we collect all export pids as they come from the          (* Here we collect all export pids as they come from the
40           * environments.  They may differ from those in the dynamic           * environments.  They may differ from those in the dynamic
# Line 51  Line 46 
46    
47          fun getdyn rebuilt = let          fun getdyn rebuilt = let
48              (* ignore the very last pid -- it's the runtime system! *)              (* ignore the very last pid -- it's the runtime system! *)
49              fun convert (CONSrde (_, _, NILrde), [_]) = DynE.empty              fun convert (U.CONSrde (_, _, U.NILrde), [_]) = DynE.empty
50                | convert (CONSrde (raw_dynpid, obj, rest), stpid :: pids) = let                | convert (U.CONSrde (rawdynpid, obj, rest), stpid :: pids) = let
51                      val dynpid = PS.fromBytes raw_dynpid                      val dynpid = PS.fromBytes rawdynpid
52                      val _ =                      val _ =
53                          if rebuilt orelse stpid = dynpid then ()                          if rebuilt orelse stpid = dynpid then ()
54                          else die (concat                          else die (concat
# Line 63  Line 58 
58                      DynE.bind (stpid, obj, convert (rest, pids))                      DynE.bind (stpid, obj, convert (rest, pids))
59                  end                  end
60                | convert _ = die "Pid list mismatch\n"                | convert _ = die "Pid list mismatch\n"
61              val rde = !a_pstruct before a_pstruct := NILrde              val rde = !U.pStruct before U.pStruct := U.NILrde
62              val stpids = !stpids before stpids := []              val stpids = !stpids before stpids := []
63          in          in
64              convert (rde, stpids)              convert (rde, stpids)
# Line 71  Line 66 
66      end      end
67    
68      (* get the boot environments from the binfiles *)      (* get the boot environments from the binfiles *)
69      fun fetchBootEnv (bindir, full, rebuilt) = let      fun fetchBootEnv (bindir, ereq, rebuilt) = let
70    
71          fun b name = OS.Path.joinDirFile { dir = bindir, file = name }          fun b name = OS.Path.joinDirFile { dir = bindir, file = name }
72    
# Line 110  Line 105 
105    
106          infix //          infix //
107          fun (st1, sy1) // (st2, sy2) =          fun (st1, sy1) // (st2, sy2) =
108              (CMS.atop (st1, st2), SymE.atop (sy1, sy2))              (CMS.atop (st1, st2), Env.layerSymbolic (sy1, sy2))
109    
110          (* magic file names *)          (* magic file names *)
111          val assembly_sig = "assembly.sig.bin"          val assembly_sig = "assembly.sig.bin"
112          val dummy_sml = "dummy.sml.bin"          val dummy_sml = "dummy.sml.bin"
113          val core_sml = "core.sml.bin"          val core_sml = "core.sml.bin"
114    
115            val emptysym = Env.symbolicPart Env.emptyEnv
116    
117          (* build the core environment *)          (* build the core environment *)
118          val _ = say "----- CORE ENVIRONMENT -----\n"          val _ = say "----- CORE ENVIRONMENT -----\n"
119          val prim = (CMS.CM PrimEnv.primEnv, SymE.empty)          val prim = (CMS.CM PrimEnv.primEnv, emptysym)
120          val sig_prim = getbin (#1 prim, assembly_sig) // prim          val sig_prim = getbin (#1 prim, assembly_sig) // prim
121          val dummy_env = getbin (#1 sig_prim, dummy_sml) // sig_prim          val dummy_env = getbin (#1 sig_prim, dummy_sml) // sig_prim
122          val core_env = getbin (#1 dummy_env, core_sml)          val core_env = getbin (#1 dummy_env, core_sml)
# Line 131  Line 128 
128                | loop (f1 :: files, env) =                | loop (f1 :: files, env) =
129                  loop (files, getbin (CMS.atop (#1 env, scontext), f1) // env)                  loop (files, getbin (CMS.atop (#1 env, scontext), f1) // env)
130          in          in
131              loop (files, (CMS.empty, SymE.empty))              loop (files, (CMS.empty, emptysym))
132          end          end
133    
134          (* load all the files from BOOTLIST *)          (* load all the files from BOOTLIST *)
# Line 152  Line 149 
149          val pervstatenv = CMS.unCM pervstatenv          val pervstatenv = CMS.unCM pervstatenv
150          val compstatenv = CMS.unCM compstatenv          val compstatenv = CMS.unCM compstatenv
151    
152          (* add stuff to the pervasive env (depends on "full" flag) *)          (* add stuff to the pervasive env (depends on "ereq" flag) *)
153          val _ = say "----- COMPILER BINDINGS -----\n"          val _ = say "----- COMPILER BINDINGS -----\n"
154          val pervstatenv =          val pervstatenv =
155              if full then              let
                 (* "full" compiler -> put everything and the kitchen sink into  
                  *                    the pervasive environment *)  
                 SE.atop (compstatenv, pervstatenv)  
             else let  
                 (* normal compile -> put only a few bindings into pervenv *)  
   
156                  (* looking for symbols in compiler's static env *)                  (* looking for symbols in compiler's static env *)
157                  fun complook sym =                  fun complook sym =
158                      SE.look (compstatenv, sym)                      SE.look (compstatenv, sym)
# Line 187  Line 178 
178                      foldl comprebind (SE.bind (sym, b, e)) sigsyms                      foldl comprebind (SE.bind (sym, b, e)) sigsyms
179                  end                  end
180    
181                    (* function for just rebinding the visible compiler *)
182                    fun rebind_viscomp () =
183                        comprebind_strsym (Symbol.strSymbol "Compiler",
184                                           pervstatenv)
185                in
186                    case ereq of
187                        BARE => rebind_viscomp () (* no CM, CMB, ... *)
188                      | FULL =>
189                            (* "full" compiler ->
190                             *         put everything and the kitchen sink into
191                             *         the pervasive environment *)
192                            SE.atop (compstatenv, pervstatenv)
193                      | NORMAL => let
194                        (* normal compile ->
195                         *             put only a few bindings into pervenv *)
196              in              in
197                  (* introduce bindings for compiler into pervasive env *)                          foldl comprebind (rebind_viscomp ())
                 foldl comprebind  
                   (comprebind_strsym (Symbol.strSymbol "Compiler",  
                                       pervstatenv))  
198                    [Symbol.strSymbol "CM",                    [Symbol.strSymbol "CM",
199                     Symbol.strSymbol "CMB",                     Symbol.strSymbol "CMB",
200                     Symbol.sigSymbol "CMTOOLS",                     Symbol.sigSymbol "CMTOOLS",
201                     Symbol.sigSymbol "COMPILATION_MANAGER"]                     Symbol.sigSymbol "COMPILATION_MANAGER"]
202              end              end
203                end
204    
205          (* consolidating static part *)          (* consolidating static part *)
206          val pervstatenv = SE.consolidate pervstatenv          val pervstatenv = SE.consolidate pervstatenv
# Line 206  Line 210 
210           *       bindings responsible for stuff in core env! *)           *       bindings responsible for stuff in core env! *)
211          val (dynamic, symbolic) = let          val (dynamic, symbolic) = let
212              val fulldynenv = getdyn rebuilt              val fulldynenv = getdyn rebuilt
213              val fullsymenv = SymE.atop (compsymenv,              val fullsymenv =
214                                          SymE.atop (pervsymenv, #2 core_env))                  Env.layerSymbolic (compsymenv,
215                                       Env.layerSymbolic (pervsymenv, #2 core_env))
216              val trimstatic = SE.atop (pervstatenv, CMS.unCM (#1 core_env))              val trimstatic = SE.atop (pervstatenv, CMS.unCM (#1 core_env))
217              val tobetrimmed = { static = trimstatic,              val tobetrimmed = { static = trimstatic,
218                                  dynamic = fulldynenv, symbolic = fullsymenv }                                  dynamic = fulldynenv, symbolic = fullsymenv }
219              val { dynamic, symbolic, ... } = Environment.trimEnv tobetrimmed              val { dynamic, symbolic, ... } = Env.trimEnv tobetrimmed
220          in          in
221              (dynamic, symbolic)              (dynamic, symbolic)
222          end          end
# Line 227  Line 232 
232              if String.isPrefix prefix arg then              if String.isPrefix prefix arg then
233                  SOME (String.extract (arg, size prefix, NONE))                  SOME (String.extract (arg, size prefix, NONE))
234              else NONE              else NONE
235          fun bootArgs ([], bootdir, newbindir, full) =          fun bootArgs ([], bootdir, newbindir, ereq) =
236              (bootdir, newbindir, full)              (bootdir, newbindir, ereq)
237            | bootArgs ("@SMLfull" :: rest, bootdir, newbindir, _) =            | bootArgs ("@SMLfull" :: rest, bootdir, newbindir, _) =
238              bootArgs (rest, bootdir, newbindir, true)              bootArgs (rest, bootdir, newbindir, FULL)
239            | bootArgs (head :: rest, bootdir, newbindir, full) =            | bootArgs ("@SMLbare" :: rest, bootdir, newbindir, _) =
240                bootArgs (rest, bootdir, newbindir, BARE)
241              | bootArgs (head :: rest, bootdir, newbindir, ereq) =
242              (case vArg ("@SMLboot=", head) of              (case vArg ("@SMLboot=", head) of
243                   SOME bootdir =>                   SOME bootdir =>
244                       bootArgs (rest, bootdir, newbindir, full)                       bootArgs (rest, bootdir, newbindir, ereq)
245                 | NONE => (case vArg ("@SMLrebuild=", head) of                 | NONE => (case vArg ("@SMLrebuild=", head) of
246                                newbindir as SOME _ =>                                newbindir as SOME _ =>
247                                    bootArgs (rest, bootdir, newbindir, full)                                    bootArgs (rest, bootdir, newbindir, ereq)
248                              | NONE =>                              | NONE =>
249                                    bootArgs (rest, bootdir, newbindir, full)))                                    bootArgs (rest, bootdir, newbindir, ereq)))
250    
251          val (bootdir, newbindir, full) =          val (bootdir, newbindir, ereq) =
252              bootArgs (SMLofNJ.getAllArgs (),              bootArgs (SMLofNJ.getAllArgs (),
253                        "bin." ^ VC.architecture, NONE, false)                        "bin." ^ VC.architecture, NONE, NORMAL)
254          val bootdir = OS.Path.mkCanonical bootdir          val bootdir = OS.Path.mkCanonical bootdir
255          val newbindir = Option.map OS.Path.mkCanonical newbindir          val newbindir = Option.map OS.Path.mkCanonical newbindir
256    
# Line 255  Line 262 
262                      die "@SMLboot= and @SMLrebuild= name the same directory\n"                      die "@SMLboot= and @SMLrebuild= name the same directory\n"
263                    else (recompile nbd; (nbd, true))                    else (recompile nbd; (nbd, true))
264      in      in
265          fetchBootEnv (goodbindir, full, rebuilt)          fetchBootEnv (goodbindir, ereq, rebuilt)
266      end      end
267  end  end

Legend:
Removed from v.142  
changed lines
  Added in v.143

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