Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/branches/SMLNJ/src/system/IntSys/boot-env-fn.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/system/IntSys/boot-env-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 498 - (view) (download)

1 : monnier 416 (*
2 :     * Copyright 1996 by Bell Laboratories
3 :     * boot.sml -- bootstrap environments
4 :     *
5 :     * completely redone by M.Blume (5/1998)
6 :     * ... and again in the course of switching over to the new CM
7 :     * (M. Blume, 7/1999)
8 :     *)
9 :     signature BOOTENV = sig
10 : monnier 498 val init: unit -> { heapfile: string, procCmdLine: (unit -> unit) option }
11 : monnier 416 end
12 :    
13 :     functor BootEnvF (datatype envrequest = AUTOLOAD | BARE
14 :     val architecture: string
15 : monnier 498 val cminit : string * DynamicEnv.dynenv * envrequest ->
16 :     (unit -> unit) option
17 : monnier 416 val cmbmake: string -> unit) :> BOOTENV = struct
18 :    
19 :     exception BootFailure
20 :    
21 :     structure DynE = DynamicEnv
22 :     structure Print = GenericVC.Control.Print
23 :    
24 :     fun say s = (Print.say s; Print.flush ())
25 :     fun die s = (say s; raise BootFailure)
26 :    
27 :     (* just run CMB.make to make a new set of binfiles... *)
28 :     fun recompile bindir =
29 :     (say (concat ["[building new binfiles in ", bindir, "]\n"]);
30 :     cmbmake bindir;
31 :     OS.Process.exit OS.Process.success)
32 :    
33 :     local
34 :     structure U = Unsafe
35 :     in
36 :     fun initialize (bootdir, er) = let
37 :     fun mkDE (U.NILrde, de) = de
38 :     | mkDE (U.CONSrde (rawdynpid, obj, rest), de) = let
39 :     val dynpid = GenericVC.PersStamps.fromBytes rawdynpid
40 :     in
41 :     mkDE (rest, DynE.bind (dynpid, obj, de))
42 :     end
43 :     val de = mkDE (!U.pStruct, DynE.empty)
44 :     in
45 :     U.pStruct := U.NILrde;
46 :     cminit (bootdir, de, er)
47 :     end
48 :     end
49 :    
50 :     fun init () = let
51 :     (* grab relevant command line arguments... *)
52 :     fun vArg (prefix, arg) =
53 :     if String.isPrefix prefix arg then
54 :     SOME (String.extract (arg, size prefix, NONE))
55 :     else NONE
56 :     fun bootArgs ([], bootdir, newbindir, heapfile, er) =
57 :     (bootdir, newbindir, heapfile, er)
58 :     | bootArgs ("@SMLbare" :: rest, bootdir, newbindir, heapfile, _) =
59 :     bootArgs (rest, bootdir, newbindir, heapfile, BARE)
60 :     | bootArgs (head :: rest, bootdir, newbindir, heapfile, er) =
61 :     (case vArg ("@SMLboot=", head) of
62 :     SOME bootdir =>
63 :     bootArgs (rest, bootdir, newbindir, heapfile, er)
64 :     | NONE =>
65 :     (case vArg ("@SMLrebuild=", head) of
66 :     newbindir as SOME _ =>
67 :     bootArgs (rest, bootdir, newbindir, heapfile, er)
68 :     | NONE =>
69 :     (case vArg ("@SMLheap=", head) of
70 :     SOME heapfile =>
71 :     bootArgs (rest, bootdir, newbindir,
72 :     heapfile, er)
73 :     | NONE =>
74 :     bootArgs (rest, bootdir, newbindir,
75 :     heapfile, er))))
76 :    
77 :     val (bootdir, newbindir, heapfile, er) =
78 :     bootArgs (SMLofNJ.getAllArgs (),
79 :     "comp.boot." ^ architecture,
80 :     NONE,
81 :     "sml." ^ architecture,
82 :     AUTOLOAD)
83 :     val bootdir = OS.Path.mkCanonical bootdir
84 :     val newbindir = Option.map OS.Path.mkCanonical newbindir
85 :     in
86 :     case newbindir of
87 : monnier 498 NONE => let
88 :     val procCmdLine = initialize (bootdir, er)
89 :     in
90 :     { heapfile = heapfile, procCmdLine = procCmdLine }
91 :     end
92 : monnier 416 | SOME nbd =>
93 :     if nbd = bootdir then
94 :     die "@SMLboot= and @SMLrebuild= name the same directory\n"
95 :     else recompile nbd
96 :     end
97 :     end

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