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 363, Fri Jul 2 02:45:45 1999 UTC revision 364, Fri Jul 2 07:33:12 1999 UTC
# Line 8  Line 8 
8   *)   *)
9  functor BootstrapCompileFn (structure MachDepVC: MACHDEP_VC  functor BootstrapCompileFn (structure MachDepVC: MACHDEP_VC
10                              val os: SMLofNJ.SysInfo.os_kind) :> sig                              val os: SMLofNJ.SysInfo.os_kind) :> sig
11      val recomp' : string option -> bool      val make' : string option -> bool
12      val recomp : unit -> bool      val make : unit -> bool
13      val deliver' : string option -> bool      val deliver' : string option -> bool
14      val deliver : unit -> bool      val deliver : unit -> bool
15      val reset : unit -> unit      val reset : unit -> unit
# Line 23  Line 23 
23      structure CoerceEnv = GenericVC.CoerceEnv      structure CoerceEnv = GenericVC.CoerceEnv
24      structure SSV = SpecificSymValFn (structure MachDepVC = MachDepVC      structure SSV = SpecificSymValFn (structure MachDepVC = MachDepVC
25                                        val os = os)                                        val os = os)
26        structure P = OS.Path
27        structure F = OS.FileSys
28    
29      (* Since the bootstrap compiler never executes any of the code      (* Since the bootstrap compiler never executes any of the code
30       * it produces, we don't need any dynamic values.  Therefore,       * it produces, we don't need any dynamic values.  Therefore,
# Line 52  Line 54 
54      structure Parse = ParseFn (structure Stabilize = Stabilize      structure Parse = ParseFn (structure Stabilize = Stabilize
55                                 val pending = AutoLoad.getPending)                                 val pending = AutoLoad.getPending)
56    
57      fun listName p =      fun cpTextStreams (ins, outs) = let
58          case OS.Path.fromString p of          val N = 4096
59              { vol = "", isAbs = false, arcs = _ :: arc1 :: arcn } => let          fun cp () =
60                  fun win32name () =              if TextIO.endOfStream ins then ()
61                      concat (arc1 ::              else (TextIO.output (outs,
62                              foldr (fn (a, r) => "\\" :: a :: r) [] arcn)                                   TextIO.inputN (ins, N));
63                      cp ())
64              in              in
65                  case os of          cp ()
                     SMLofNJ.SysInfo.WIN32 => win32name ()  
                   | _ => OS.Path.toString { isAbs = false, vol = "",  
                                             arcs = arc1 :: arcn }  
66              end              end
67            | _ => raise Fail "BootstrapCompile:listName: bad name"  
68        fun openTextStreams (inf, outf) () =
69            (TextIO.openIn inf, AutoDir.openTextOut outf)
70        fun closeTextStreams (ins, outs) =
71            (TextIO.closeIn ins; TextIO.closeOut outs)
72    
73        fun copyFile (inf, outf) =
74            SafeIO.perform { openIt = openTextStreams (inf, outf),
75                             closeIt = closeTextStreams,
76                             work = cpTextStreams,
77                             cleanup = fn () =>
78                                (F.remove outf handle _ => ()) }
79    
80      fun compile deliver dbopt = let      fun compile deliver dbopt = let
81    
# Line 78  Line 89 
89          val bindir = concat [dirbase, ".bin.", arch, "-", osname]          val bindir = concat [dirbase, ".bin.", arch, "-", osname]
90          val bootdir = concat [dirbase, ".boot.", arch, "-", osname]          val bootdir = concat [dirbase, ".boot.", arch, "-", osname]
91    
92            fun listName (p, copy) =
93                case P.fromString p of
94                    { vol = "", isAbs = false, arcs = arc0 :: arc1 :: arcn } => let
95                        fun win32name () =
96                            concat (arc1 ::
97                                    foldr (fn (a, r) => "\\" :: a :: r) [] arcn)
98                        fun doCopy () = let
99                            val bootpath =
100                                P.toString { isAbs = false, vol = "",
101                                             arcs = bootdir :: arc1 :: arcn }
102                        in
103                            copyFile (p, bootpath)
104                        end
105                    in
106                        if copy andalso arc0 = bindir then doCopy () else ();
107                        case os of
108                            SMLofNJ.SysInfo.WIN32 => win32name ()
109                          | _ => P.toString { isAbs = false, vol = "",
110                                              arcs = arc1 :: arcn }
111                    end
112                  | _ => raise Fail "BootstrapCompile:listName: bad name"
113    
114          val keep_going = EnvConfig.getSet StdConfig.keep_going NONE          val keep_going = EnvConfig.getSet StdConfig.keep_going NONE
115    
116          val ctxt = SrcPath.cwdContext ()          val ctxt = SrcPath.cwdContext ()
117    
118          val pidfile = OS.Path.joinDirFile { dir = bootdir, file = "RTPID" }          val pidfile = P.joinDirFile { dir = bootdir, file = "RTPID" }
119          val listfile = OS.Path.joinDirFile { dir = bootdir, file = "BOOTLIST" }          val listfile = P.joinDirFile { dir = bootdir, file = "BOOTLIST" }
120    
121          val pcmode = PathConfig.new ()          val pcmode = PathConfig.new ()
122          val _ = PathConfig.processSpecFile (pcmode, pcmodespec)          val _ = PathConfig.processSpecFile (pcmode, pcmodespec)
# Line 96  Line 129 
129          val cmifile = valOf (SrcPath.reAnchoredName (initgspec, bootdir))          val cmifile = valOf (SrcPath.reAnchoredName (initgspec, bootdir))
130              handle Option => raise Fail "BootstrapCompile: cmifile"              handle Option => raise Fail "BootstrapCompile: cmifile"
131    
132          val initfnpolicy =          val fnpolicy =
             FilenamePolicy.separate { bindir = bootdir, bootdir = bootdir }  
                 { arch = arch, os = os }  
   
         val mainfnpolicy =  
133              FilenamePolicy.separate { bindir = bindir, bootdir = bootdir }              FilenamePolicy.separate { bindir = bindir, bootdir = bootdir }
134                  { arch = arch, os = os }                  { arch = arch, os = os }
135    
136          fun mkParam { primconf, pervasive, pervcorepids, fnpolicy }          fun mkParam { primconf, pervasive, pervcorepids }
137                      { corenv } =                      { corenv } =
138              { primconf = primconf,              { primconf = primconf,
139                fnpolicy = fnpolicy,                fnpolicy = fnpolicy,
# Line 123  Line 152 
152          val primconf = Primitive.primEnvConf          val primconf = Primitive.primEnvConf
153          val mkInitParam = mkParam { primconf = primconf,          val mkInitParam = mkParam { primconf = primconf,
154                                      pervasive = E.emptyEnv,                                      pervasive = E.emptyEnv,
155                                      pervcorepids = PidSet.empty,                                      pervcorepids = PidSet.empty }
                                     fnpolicy = initfnpolicy }  
156    
157          val param_nocore = mkInitParam { corenv = BE.staticPart BE.emptyEnv }          val param_nocore = mkInitParam { corenv = BE.staticPart BE.emptyEnv }
158    
# Line 185  Line 213 
213                              PidSet.addList (PidSet.empty,                              PidSet.addList (PidSet.empty,
214                                              [#2 (#stat pervasive),                                              [#2 (#stat pervasive),
215                                               #2 (#sym pervasive),                                               #2 (#sym pervasive),
216                                               #2 (#stat core)]),                                               #2 (#stat core)]) }
                           fnpolicy = mainfnpolicy }  
217                          { corenv = corenv }                          { corenv = corenv }
218              val stab =              val stab =
219                  if deliver then SOME true else NONE                  if deliver then SOME true else NONE
# Line 196  Line 223 
223                | SOME (g, gp) =>                | SOME (g, gp) =>
224                      if recomp gp g then let                      if recomp gp g then let
225                          val rtspid = PS.toHex (#2 (#stat rts))                          val rtspid = PS.toHex (#2 (#stat rts))
                         val bootfiles =  
                             map (fn x => (x, NONE)) binpaths @  
                             MkBootList.group g  
226                          fun writeList s = let                          fun writeList s = let
227                              fun offset NONE = ["\n"]                              fun add ((p, flag), l) = let
228                                | offset (SOME i) = ["@", Int.toString i, "\n"]                                  val n = listName (p, true)
                             fun showBootFile (p, off) =  
                                 TextIO.output (s, concat (listName p ::  
                                                           offset off))  
229                          in                          in
230                              app showBootFile bootfiles                                  if flag then n :: l else l
231                          end                          end
232                          fun cpCMI (ins, outs) = let                              fun transcribe (p, NONE) = listName (p, true)
233                              val N = 4096                                | transcribe (p, SOME (off, desc)) =
234                              fun cp () =                                  concat [listName (p, false),
235                                  if TextIO.endOfStream ins then ()                                          "@", Int.toString off, ":", desc]
236                                  else (TextIO.output (outs,                              val bootstrings =
237                                                       TextIO.inputN (ins, N));                                  foldr add (map transcribe (MkBootList.group g))
238                                        cp ())                                        binpaths
239                                fun show str =
240                                    (TextIO.output (s, str);
241                                     TextIO.output (s, "\n"))
242                          in                          in
243                              cp ()                              app show bootstrings
244                          end                          end
245                      in                      in
246                        Say.say ["Runtime System PID is: ", rtspid, "\n"];                        Say.say ["Runtime System PID is: ", rtspid, "\n"];
# Line 236  Line 260 
260                                           cleanup = fn () =>                                           cleanup = fn () =>
261                                             OS.FileSys.remove listfile                                             OS.FileSys.remove listfile
262                                             handle _ => () };                                             handle _ => () };
263                          SafeIO.perform { openIt = fn () =>                          copyFile (SrcPath.osstring initgspec, cmifile))
                                            (SrcPath.openTextIn initgspec,  
                                             AutoDir.openTextOut cmifile),  
                                          closeIt = fn (ins, outs) =>  
                                            (TextIO.closeIn ins;  
                                             TextIO.closeOut outs),  
                                          work = cpCMI,  
                                          cleanup = fn () =>  
                                            OS.FileSys.remove cmifile  
                                            handle _ => () })  
264                        else ();                        else ();
265                        true                        true
266                      end                      end
# Line 258  Line 273 
273            | NONE => false            | NONE => false
274      end      end
275    
276      val recomp' = compile false      val make' = compile false
277      fun recomp () = recomp' NONE      fun make () = make' NONE
278      val deliver' = compile true      val deliver' = compile true
279      fun deliver () = deliver' NONE      fun deliver () = deliver' NONE
280      fun reset () =      fun reset () =

Legend:
Removed from v.363  
changed lines
  Added in v.364

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