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 592, Mon Apr 3 07:04:12 2000 UTC revision 676, Sat Jun 24 03:37:03 2000 UTC
# Line 17  Line 17 
17  functor BootstrapCompileFn  functor BootstrapCompileFn
18              (structure MachDepVC : MACHDEP_VC              (structure MachDepVC : MACHDEP_VC
19               val os : SMLofNJ.SysInfo.os_kind               val os : SMLofNJ.SysInfo.os_kind
20               val load_plugin : SrcPath.context -> string -> bool) :> sig               val load_plugin : SrcPath.dir -> string -> bool) :> sig
21      val make' : string option -> bool      val make' : string option -> bool
22      val make : unit -> bool      val make : unit -> bool
23      val reset : unit -> unit      val reset : unit -> unit
# Line 31  Line 31 
31    
32      val arch = MachDepVC.architecture      val arch = MachDepVC.architecture
33      val osname = FilenamePolicy.kind2name os      val osname = FilenamePolicy.kind2name os
34    
35      val archos = concat [arch, "-", osname]      val archos = concat [arch, "-", osname]
36    
37      fun init_servers (GG.GROUP { grouppath, ... }) =      fun init_servers (GG.GROUP { grouppath, ... }) =
38          Servers.cmb { archos = archos,          Servers.cmb { archos = archos,
39                        root = SrcPath.descr grouppath }                        root = SrcPath.encode grouppath }
40        | init_servers GG.ERRORGROUP = ()        | init_servers GG.ERRORGROUP = ()
41    
42      structure StabModmap = StabModmapFn ()      structure StabModmap = StabModmapFn ()
# Line 43  Line 44 
44      structure Compile = CompileFn (structure MachDepVC = MachDepVC      structure Compile = CompileFn (structure MachDepVC = MachDepVC
45                                     structure StabModmap = StabModmap                                     structure StabModmap = StabModmap
46                                     val compile_there =                                     val compile_there =
47                                         Servers.compile o SrcPath.descr)                                         Servers.compile o SrcPath.encode)
48    
49      structure BFC = BfcFn (structure MachDepVC = MachDepVC)      structure BFC = BfcFn (structure MachDepVC = MachDepVC)
50    
# Line 117  Line 118 
118    
119      fun mk_compile { deliver, root, dirbase = dbopt, paranoid } = let      fun mk_compile { deliver, root, dirbase = dbopt, paranoid } = let
120    
         val _ = StabModmap.reset ()  
   
121          val dirbase = getOpt (dbopt, BtNames.dirbaseDefault)          val dirbase = getOpt (dbopt, BtNames.dirbaseDefault)
122          val _ = checkDirbase dirbase          val _ = checkDirbase dirbase
123          val pcmodespec = BtNames.pcmodespec          val penvspec = BtNames.penvspec
124          val initgspec = BtNames.initgspec          val initgspec = BtNames.initgspec
125          val maingspec = BtNames.maingspec          val maingspec = BtNames.maingspec
126    
# Line 130  Line 129 
129    
130          val keep_going = #get StdConfig.keep_going ()          val keep_going = #get StdConfig.keep_going ()
131    
132          val ctxt = SrcPath.cwdContext ()          val ctxt = SrcPath.cwd ()
133    
134          val listfile = P.joinDirFile { dir = bootdir, file = BtNames.bootlist }          val listfile = P.joinDirFile { dir = bootdir, file = BtNames.bootlist }
135          val pidmapfile = P.joinDirFile { dir = bootdir, file = BtNames.pidmap }          val pidmapfile = P.joinDirFile { dir = bootdir, file = BtNames.pidmap }
136    
137          val pcmode = PathConfig.new ()          val penv = SrcPath.newEnv ()
138          val _ = PathConfig.processSpecFile (pcmode, pcmodespec)          val _ = SrcPath.processSpecFile (penv, penvspec)
139            val _ = SrcPath.sync ()
140          fun stdpath s = SrcPath.standard pcmode { context = ctxt, spec = s }  
141            fun stdpath s =
142                SrcPath.file (SrcPath.standard
143                                  { err = fn s => raise Fail s, env = penv }
144                                  { context = ctxt, spec = s })
145    
146          val initgspec = stdpath initgspec          val initgspec = stdpath initgspec
147          val maingspec =          val maingspec =
148              case root of              case root of
149                  NONE => stdpath maingspec                  NONE => stdpath maingspec
150                | SOME r => SrcPath.fromDescr pcmode r                | SOME r => SrcPath.decode penv r
151    
152          val fnpolicy =          val fnpolicy =
153              FilenamePolicy.separate { bindir = bindir, bootdir = bootdir }              FilenamePolicy.separate { bindir = bindir, bootdir = bootdir }
# Line 152  Line 155 
155    
156          val param =          val param =
157              { fnpolicy = fnpolicy,              { fnpolicy = fnpolicy,
158                pcmode = pcmode,                penv = penv,
159                symval = SSV.symval,                symval = SSV.symval,
160                keep_going = keep_going }                keep_going = keep_going }
161    
# Line 183  Line 186 
186                  fun rt2ie (n, ii: IInfo.info) = let                  fun rt2ie (n, ii: IInfo.info) = let
187                      val s = #statenv ii ()                      val s = #statenv ii ()
188                      val (dae, mkDomain) = Statenv2DAEnv.cvt s                      val (dae, mkDomain) = Statenv2DAEnv.cvt s
189                        val domain = mkDomain ()
190                  in                  in
191                      (* Link path info = NONE, will be reset at import                      { ie = (fn () => (NONE, n), dae, domain), domain = domain }
                      * time (in members.sml). *)  
                     { ie = ((NONE, n), dae), mkDomain = mkDomain }  
192                  end                  end
193    
194                  fun add_exports (n, exports) = let                  fun add_exports (n, exports) = let
195                      val { ie, mkDomain } = rt2ie (n, rt n)                      val { ie, domain } = rt2ie (n, rt n)
196                      fun ins_ie (sy, m) = SymbolMap.insert (m, sy, ie)                      fun ins_ie (sy, m) = SymbolMap.insert (m, sy, ie)
197                  in                  in
198                      SymbolSet.foldl ins_ie exports (mkDomain ())                      SymbolSet.foldl ins_ie exports domain
199                  end                  end
200    
201                  val special_exports = let                  val special_exports = let
# Line 205  Line 207 
207                  end                  end
208              in              in
209                  GG.GROUP { exports = foldl add_exports special_exports others,                  GG.GROUP { exports = foldl add_exports special_exports others,
210                             kind = GroupGraph.LIB { wrapped = StringSet.empty,                             kind = GG.LIB {
211                                 kind = GG.DEVELOPED { wrapped = StringSet.empty,
212                                                     subgroups = [] },                                                     subgroups = [] },
213                                    version = NONE },
214                             required = StringSet.singleton "primitive",                             required = StringSet.singleton "primitive",
215                             grouppath = initgspec,                             grouppath = initgspec,
216                               (* hack: sources never used for this group *)
217                               sources = SrcPathMap.empty,
218                             sublibs = [] }                             sublibs = [] }
219                  before (ovldR := savedOvld)                  before (ovldR := savedOvld)
220              end              end
# Line 219  Line 225 
225                      { getGroup = fn _ => raise Fail "CMB: initial getGroup",                      { getGroup = fn _ => raise Fail "CMB: initial getGroup",
226                        anyerrors = ref false }                        anyerrors = ref false }
227              in              in
228                  case Stabilize.loadStable ginfo lsarg initgspec of                  case Stabilize.loadStable lsarg (ginfo, initgspec, NONE, []) of
229                      NONE => NONE                      NONE => NONE
230                    | SOME (g as GG.GROUP { exports, ... }) => SOME g                    | SOME (g as GG.GROUP { exports, ... }) => SOME g
231                    | SOME GG.ERRORGROUP => NONE                    | SOME GG.ERRORGROUP => NONE
# Line 251  Line 257 
257                  if paranoid then let                  if paranoid then let
258                      val export_nodes = perv_n :: others                      val export_nodes = perv_n :: others
259                      val ver_arg = (initgspec, export_nodes, [],                      val ver_arg = (initgspec, export_nodes, [],
260                                     SrcPathSet.empty)                                     SrcPathSet.empty, NONE)
261                      val em = StableMap.empty                      val em = StableMap.empty
262                  in                  in
263                      if VerifyStable.verify' ginfo em ver_arg then                      if VerifyStable.verify' ginfo em ver_arg then
# Line 276  Line 282 
282                    paranoid = paranoid }                    paranoid = paranoid }
283          in          in
284              Servers.dirbase dirbase;              Servers.dirbase dirbase;
285                Servers.cmb_new { archos = archos };
286              case Parse.parse parse_arg of              case Parse.parse parse_arg of
287                  NONE => NONE                  NONE => NONE
288                | SOME (g, gp) => let                | SOME (g, gp) => let
# Line 319  Line 326 
326                              end                              end
327                              fun writePidLine s (p, set) =                              fun writePidLine s (p, set) =
328                                  if StableSet.isEmpty set then ()                                  if StableSet.isEmpty set then ()
329                                  else (TextIO.output (s, SrcPath.descr p);                                  else (TextIO.output (s, SrcPath.encode p);
330                                        StableSet.app (writePid s) set;                                        StableSet.app (writePid s) set;
331                                        TextIO.output (s, "\n"))                                        TextIO.output (s, "\n"))
332                              fun writePidMap s =                              fun writePidMap s =
# Line 350  Line 357 
357                          else false                          else false
358                      end                      end
359                  in                  in
360                      SOME ((g, gp, pcmode), thunk)                      SOME ((g, gp, penv), thunk)
361                  end                  end
362          end handle Option => (Compile.reset (); NONE)          end handle Option => (Compile.reset (); NONE)
363                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
# Line 361  Line 368 
368      end      end
369    
370      fun compile dbopt =      fun compile dbopt =
371            (StabModmap.reset ();
372          case mk_compile { deliver = true, root = NONE,          case mk_compile { deliver = true, root = NONE,
373                            dirbase = dbopt, paranoid = true } of                            dirbase = dbopt, paranoid = true } of
374              NONE => false              NONE => false
375            | SOME (_, thunk) => thunk ()             | SOME (_, thunk) => thunk ())
376    
377      local      local
378          fun slave (dirbase, root) =          fun slave NONE = (StabModmap.reset (); NONE)
379              | slave (SOME (dirbase, root)) =
380              case mk_compile { deliver = false, root = SOME root,              case mk_compile { deliver = false, root = SOME root,
381                                dirbase = SOME dirbase, paranoid = false } of                                dirbase = SOME dirbase, paranoid = false } of
382                  NONE => NONE                  NONE => NONE
383                | SOME ((g, gp, pcmode), _) => let                | SOME ((g, gp, penv), _) => let
384                      val trav = Compile.newSbnodeTraversal () gp                      val trav = Compile.newSbnodeTraversal () gp
385                      fun trav' sbn = isSome (trav sbn)                      fun trav' sbn = isSome (trav sbn)
386                  in                  in
387                      SOME (g, trav', pcmode)                      SOME (g, trav', penv)
388                  end                  end
389      in      in
390          val _ = CMBSlaveHook.init archos slave          val _ = CMBSlaveHook.init archos slave

Legend:
Removed from v.592  
changed lines
  Added in v.676

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