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

Parent Directory | 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