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 665, Fri Jun 16 04:43:57 2000 UTC revision 666, Fri Jun 16 08:27:00 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 36  Line 36 
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 44  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 120  Line 120 
120    
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 129  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    
140          fun stdpath s = SrcPath.standard pcmode { context = ctxt,          fun stdpath s =
141                                                    spec = s,              SrcPath.file (SrcPath.standard
142                                                    err = fn s => raise Fail s }                                { err = fn s => raise Fail s, env = penv }
143                                  { context = ctxt, spec = s })
144    
145          val initgspec = stdpath initgspec          val initgspec = stdpath initgspec
146          val maingspec =          val maingspec =
147              case root of              case root of
148                  NONE => stdpath maingspec                  NONE => stdpath maingspec
149                | SOME r => SrcPath.fromDescr pcmode r                | SOME r => SrcPath.decode penv r
150    
151          val fnpolicy =          val fnpolicy =
152              FilenamePolicy.separate { bindir = bindir, bootdir = bootdir }              FilenamePolicy.separate { bindir = bindir, bootdir = bootdir }
# Line 153  Line 154 
154    
155          val param =          val param =
156              { fnpolicy = fnpolicy,              { fnpolicy = fnpolicy,
157                pcmode = pcmode,                penv = penv,
158                symval = SSV.symval,                symval = SSV.symval,
159                keep_going = keep_going }                keep_going = keep_going }
160    
# Line 223  Line 224 
224                      { getGroup = fn _ => raise Fail "CMB: initial getGroup",                      { getGroup = fn _ => raise Fail "CMB: initial getGroup",
225                        anyerrors = ref false }                        anyerrors = ref false }
226              in              in
227                  case Stabilize.loadStable ginfo lsarg (initgspec, NONE) of                  case Stabilize.loadStable lsarg (ginfo, initgspec, NONE, []) of
228                      NONE => NONE                      NONE => NONE
229                    | SOME (g as GG.GROUP { exports, ... }) => SOME g                    | SOME (g as GG.GROUP { exports, ... }) => SOME g
230                    | SOME GG.ERRORGROUP => NONE                    | SOME GG.ERRORGROUP => NONE
# Line 324  Line 325 
325                              end                              end
326                              fun writePidLine s (p, set) =                              fun writePidLine s (p, set) =
327                                  if StableSet.isEmpty set then ()                                  if StableSet.isEmpty set then ()
328                                  else (TextIO.output (s, SrcPath.descr p);                                  else (TextIO.output (s, SrcPath.encode p);
329                                        StableSet.app (writePid s) set;                                        StableSet.app (writePid s) set;
330                                        TextIO.output (s, "\n"))                                        TextIO.output (s, "\n"))
331                              fun writePidMap s =                              fun writePidMap s =
# Line 355  Line 356 
356                          else false                          else false
357                      end                      end
358                  in                  in
359                      SOME ((g, gp, pcmode), thunk)                      SOME ((g, gp, penv), thunk)
360                  end                  end
361          end handle Option => (Compile.reset (); NONE)          end handle Option => (Compile.reset (); NONE)
362                     (* to catch valOf failures in "rt" *)                     (* to catch valOf failures in "rt" *)
# Line 378  Line 379 
379              case mk_compile { deliver = false, root = SOME root,              case mk_compile { deliver = false, root = SOME root,
380                                dirbase = SOME dirbase, paranoid = false } of                                dirbase = SOME dirbase, paranoid = false } of
381                  NONE => NONE                  NONE => NONE
382                | SOME ((g, gp, pcmode), _) => let                | SOME ((g, gp, penv), _) => let
383                      val trav = Compile.newSbnodeTraversal () gp                      val trav = Compile.newSbnodeTraversal () gp
384                      fun trav' sbn = isSome (trav sbn)                      fun trav' sbn = isSome (trav sbn)
385                  in                  in
386                      SOME (g, trav', pcmode)                      SOME (g, trav', penv)
387                  end                  end
388      in      in
389          val _ = CMBSlaveHook.init archos slave          val _ = CMBSlaveHook.init archos slave

Legend:
Removed from v.665  
changed lines
  Added in v.666

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