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/trunk/src/system/IntSys/boot-env-fn.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 527 - (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 : blume 527 (* To be able to use ml-yacc and ml-lex at -rebuild time it is necessary
22 :     * to force their plugins to be _always_ plugged in. We achieve this
23 :     * by simply mentioning the structure names here. *)
24 :     structure YaccTool = YaccTool and LexTool = LexTool
25 :    
26 : monnier 416 structure DynE = DynamicEnv
27 :     structure Print = GenericVC.Control.Print
28 :    
29 :     fun say s = (Print.say s; Print.flush ())
30 :     fun die s = (say s; raise BootFailure)
31 :    
32 :     (* just run CMB.make to make a new set of binfiles... *)
33 :     fun recompile bindir =
34 :     (say (concat ["[building new binfiles in ", bindir, "]\n"]);
35 :     cmbmake bindir;
36 :     OS.Process.exit OS.Process.success)
37 :    
38 :     local
39 :     structure U = Unsafe
40 :     in
41 :     fun initialize (bootdir, er) = let
42 :     fun mkDE (U.NILrde, de) = de
43 :     | mkDE (U.CONSrde (rawdynpid, obj, rest), de) = let
44 :     val dynpid = GenericVC.PersStamps.fromBytes rawdynpid
45 :     in
46 :     mkDE (rest, DynE.bind (dynpid, obj, de))
47 :     end
48 :     val de = mkDE (!U.pStruct, DynE.empty)
49 :     in
50 :     U.pStruct := U.NILrde;
51 :     cminit (bootdir, de, er)
52 :     end
53 :     end
54 :    
55 :     fun init () = let
56 :     (* grab relevant command line arguments... *)
57 :     fun vArg (prefix, arg) =
58 :     if String.isPrefix prefix arg then
59 :     SOME (String.extract (arg, size prefix, NONE))
60 :     else NONE
61 :     fun bootArgs ([], bootdir, newbindir, heapfile, er) =
62 :     (bootdir, newbindir, heapfile, er)
63 :     | bootArgs ("@SMLbare" :: rest, bootdir, newbindir, heapfile, _) =
64 :     bootArgs (rest, bootdir, newbindir, heapfile, BARE)
65 :     | bootArgs (head :: rest, bootdir, newbindir, heapfile, er) =
66 :     (case vArg ("@SMLboot=", head) of
67 :     SOME bootdir =>
68 :     bootArgs (rest, bootdir, newbindir, heapfile, er)
69 :     | NONE =>
70 :     (case vArg ("@SMLrebuild=", head) of
71 :     newbindir as SOME _ =>
72 :     bootArgs (rest, bootdir, newbindir, heapfile, er)
73 :     | NONE =>
74 :     (case vArg ("@SMLheap=", head) of
75 :     SOME heapfile =>
76 :     bootArgs (rest, bootdir, newbindir,
77 :     heapfile, er)
78 :     | NONE =>
79 :     bootArgs (rest, bootdir, newbindir,
80 :     heapfile, er))))
81 :    
82 :     val (bootdir, newbindir, heapfile, er) =
83 :     bootArgs (SMLofNJ.getAllArgs (),
84 :     "comp.boot." ^ architecture,
85 :     NONE,
86 :     "sml." ^ architecture,
87 :     AUTOLOAD)
88 :     val bootdir = OS.Path.mkCanonical bootdir
89 :     val newbindir = Option.map OS.Path.mkCanonical newbindir
90 :     in
91 :     case newbindir of
92 : monnier 498 NONE => let
93 :     val procCmdLine = initialize (bootdir, er)
94 :     in
95 :     { heapfile = heapfile, procCmdLine = procCmdLine }
96 :     end
97 : monnier 416 | SOME nbd =>
98 :     if nbd = bootdir then
99 :     die "@SMLboot= and @SMLrebuild= name the same directory\n"
100 :     else recompile nbd
101 :     end
102 :     end

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