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/smlnj/internal/boot-env-fn.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 879 - (view) (download)

1 : blume 573 (*
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:
11 :     string -> { heapfile: string, procCmdLine: (unit -> unit) option }
12 :     end
13 :    
14 :     functor BootEnvF (datatype envrequest = AUTOLOAD | BARE
15 :     val architecture: string
16 :     val cminit : string * DynamicEnv.dynenv * envrequest ->
17 :     (unit -> unit) option
18 : blume 645 val cmbmake: string * bool -> unit) :> BOOTENV = struct
19 : blume 573
20 :     exception BootFailure
21 :    
22 :     (* To be able to use ml-yacc and ml-lex at -rebuild time it is necessary
23 :     * to force their plugins to be _always_ plugged in. We achieve this
24 :     * by simply mentioning the structure names here. *)
25 :     structure YaccTool = YaccTool and LexTool = LexTool
26 : blume 756 (* The classifier for dir-tool.cm must also be registered permanently... *)
27 :     structure DirToolClassify = DirToolClassify
28 : blume 573
29 :     structure DynE = DynamicEnv
30 : blume 879 structure Print = Control.Print
31 : blume 573
32 :     fun say s = (Print.say s; Print.flush ())
33 :     fun die s = (say s; raise BootFailure)
34 :    
35 :     (* just run CMB.make to make a new set of binfiles... *)
36 : blume 645 fun recompile (bindir, light) =
37 : blume 573 (say (concat ["[building new binfiles in ", bindir, "]\n"]);
38 : blume 645 cmbmake (bindir, light);
39 : blume 573 OS.Process.exit OS.Process.success)
40 :    
41 :     local
42 :     structure U = Unsafe
43 :     in
44 :     fun initialize (bootdir, er) = let
45 :     fun mkDE (U.NILrde, de) = de
46 :     | mkDE (U.CONSrde (rawdynpid, obj, rest), de) = let
47 : blume 879 val dynpid = PersStamps.fromBytes rawdynpid
48 : blume 573 in
49 :     mkDE (rest, DynE.bind (dynpid, obj, de))
50 :     end
51 :     val de = mkDE (!U.pStruct, DynE.empty)
52 :     in
53 :     U.pStruct := U.NILrde;
54 :     cminit (bootdir, de, er)
55 :     end
56 :     end
57 :    
58 :     fun init bootdir = let
59 :     (* grab relevant command line arguments... *)
60 : blume 645 fun caseArg arg cases dfl = let
61 :     fun loop [] = dfl ()
62 :     | loop ({ prefix, action } :: l) =
63 :     if String.isPrefix prefix arg then
64 :     action (String.extract (arg, size prefix, NONE))
65 :     else loop l
66 :     in
67 :     loop cases
68 :     end
69 :    
70 : blume 573 fun bootArgs ([], newbindir, heapfile, er) = (newbindir, heapfile, er)
71 :     | bootArgs ("@SMLbare" :: rest, newbindir, heapfile, _) =
72 :     bootArgs (rest, newbindir, heapfile, BARE)
73 :     | bootArgs (head :: rest, newbindir, heapfile, er) =
74 : blume 645 caseArg head
75 :     [{ prefix = "@SMLheap=",
76 :     action = fn hf => bootArgs (rest, newbindir, hf, er) },
77 :     { prefix = "@SMLrebuild=",
78 :     action = fn nbd =>
79 :     bootArgs (rest, SOME (nbd, false),
80 :     heapfile, er) },
81 :     { prefix = "@SMLlightrebuild=",
82 :     action = fn nbd =>
83 :     bootArgs (rest, SOME (nbd, true),
84 :     heapfile, er) }]
85 :     (fn () => bootArgs (rest, newbindir, heapfile, er))
86 : blume 573
87 :     val (newbindir, heapfile, er) =
88 :     bootArgs (SMLofNJ.getAllArgs (),
89 :     NONE,
90 :     "sml." ^ architecture,
91 :     AUTOLOAD)
92 :     in
93 :     case newbindir of
94 :     NONE => let
95 :     val procCmdLine = initialize (bootdir, er)
96 :     in
97 :     { heapfile = heapfile, procCmdLine = procCmdLine }
98 :     end
99 : blume 645 | SOME (nbd, light) => let
100 :     val nbd = OS.Path.mkCanonical nbd
101 :     in
102 : blume 573 if nbd = bootdir then
103 :     die "@SMLboot= and @SMLrebuild= name the same directory\n"
104 : blume 645 else recompile (nbd, light)
105 :     end
106 : blume 573 end
107 :     end

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