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 416 - (view) (download)
Original Path: sml/trunk/src/system/IntSys/boot-env-fn.sml

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

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