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

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