Annotation of /sml/trunk/src/cm/bootstrap/btcompile.sml

Parent Directory | Revision Log

---

Revision 351 - (view) (download)

1 :	blume	327	(*
2 :			* The bootstrap compiler.
3 :			* (Formerly known as "batch" compiler.)
4 :			*
5 :			* (C) 1999 Lucent Technologies, Bell Laboratories
6 :			*
7 :			* Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
8 :			*)
9 :	blume	329	functor BootstrapCompileFn (structure MachDepVC: MACHDEP_VC
10 :			val os: SMLofNJ.SysInfo.os_kind) = struct
11 :	blume	327
12 :			structure EM = GenericVC.ErrorMsg
13 :			structure E = GenericVC.Environment
14 :			structure SE = GenericVC.CMStaticEnv
15 :			structure BE = GenericVC.BareEnvironment
16 :			structure PS = GenericVC.PersStamps
17 :			structure CoerceEnv = GenericVC.CoerceEnv
18 :	blume	336	structure SSV = SpecificSymValFn (structure MachDepVC = MachDepVC
19 :			val os = os)
20 :	blume	327
21 :			(* Since the bootstrap compiler never executes any of the code
22 :			* it produces, we don't need any dynamic values. Therefore,
23 :			* we create RecompPersstate (but not FullPersstate!) and
24 :			* instantiate Recomp as well as RecompTraversal.
25 :			* Since RecompPersstate is not part of any surrounding FullPersstate,
26 :			* function "discard_value" simply does nothing. *)
27 :			structure RecompPersstate =
28 :			RecompPersstateFn (structure MachDepVC = MachDepVC
29 :			val discard_code = true
30 :			fun discard_value (i: SmlInfo.info) = ())
31 :			structure Recomp = RecompFn (structure PS = RecompPersstate)
32 :			structure RT = CompileGenericFn (structure CT = Recomp)
33 :
34 :			fun recomp gp g = isSome (RT.group gp g)
35 :
36 :			(* instantiate Stabilize... *)
37 :	blume	329	structure Stabilize =
38 :			StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode gp i)))
39 :			val recomp = recomp)
40 :	blume	327	(* ... and Parse *)
41 :			structure Parse = ParseFn (structure Stabilize = Stabilize)
42 :
43 :	blume	329	fun compile { binroot, pcmodespec, initgspec, maingspec } = let
44 :	blume	327
45 :	blume	329	val keep_going = EnvConfig.getSet StdConfig.keep_going NONE
46 :
47 :			val ctxt = AbsPath.cwdContext ()
48 :
49 :			val initgspec = AbsPath.native { context = ctxt, spec = initgspec }
50 :			val maingspec = AbsPath.native { context = ctxt, spec = maingspec }
51 :			val pcmodespec = AbsPath.native { context = ctxt, spec = pcmodespec }
52 :			val binroot = AbsPath.native { context = ctxt, spec = binroot }
53 :	blume	349	val pidfile = AbsPath.joinDirFile { dir = binroot, file = "RTPID" }
54 :			val listfile = AbsPath.joinDirFile { dir = binroot, file = "BINLIST" }
55 :	blume	329
56 :	blume	344	val pcmode = let
57 :	blume	345	fun work s = let
58 :			fun loop l = let
59 :			val line = TextIO.inputLine s
60 :			in
61 :			if line = "" then PathConfig.hardwire l
62 :			else case String.tokens Char.isSpace line of
63 :			[a, s] => loop ((a, s) :: l)
64 :			| _ => (Say.say [AbsPath.name pcmodespec,
65 :			": malformed line (ignored)\n"];
66 :			loop l)
67 :			end
68 :	blume	329	in
69 :	blume	345	loop []
70 :	blume	329	end
71 :			in
72 :	blume	345	SafeIO.perform { openIt = fn () => AbsPath.openTextIn pcmodespec,
73 :			closeIt = TextIO.closeIn,
74 :			work = work,
75 :			cleanup = fn () => () }
76 :	blume	329	end
77 :
78 :			val fnpolicy =
79 :			FilenamePolicy.separate { root = binroot,
80 :			parentArc = "DOTDOT",
81 :			absArc = "ABSOLUTE" }
82 :			{ arch = MachDepVC.architecture, os = os }
83 :
84 :	blume	349	fun mkParam { primconf, pervasive, pervcorepids } { corenv } =
85 :			{ primconf = primconf,
86 :			fnpolicy = fnpolicy,
87 :			pcmode = pcmode,
88 :			symenv = SSV.env,
89 :			keep_going = keep_going,
90 :			pervasive = pervasive,
91 :			corenv = corenv,
92 :			pervcorepids = pervcorepids }
93 :
94 :	blume	327	val emptydyn = E.dynamicPart E.emptyEnv
95 :
96 :			(* first, build an initial GeneralParam.info, so we can
97 :			* deal with the pervasive env and friends... *)
98 :			local
99 :			(* We could actually go and calculate the actual pid of primEnv.
100 :			* But in reality it's pretty pointless to do so... *)
101 :			val bogusPid = PS.fromBytes (Byte.stringToBytes "0123456789abcdef")
102 :			val pspec = { name = "primitive",
103 :			env = E.mkenv { static = E.primEnv,
104 :			symbolic = E.symbolicPart E.emptyEnv,
105 :			dynamic = emptydyn },
106 :			pidInfo = { statpid = bogusPid,
107 :			sympid = bogusPid,
108 :			ctxt = SE.empty } }
109 :			in
110 :			val primconf = Primitive.configuration [pspec]
111 :			end
112 :
113 :	blume	349	val mkInitParam = mkParam { primconf = primconf,
114 :			pervasive = E.emptyEnv,
115 :			pervcorepids = PidSet.empty }
116 :	blume	327
117 :	blume	349	val param_nocore = mkInitParam { corenv = BE.staticPart BE.emptyEnv }
118 :
119 :	blume	327	val groupreg = GroupReg.new ()
120 :			val errcons = EM.defaultConsumer ()
121 :	blume	329	val ginfo_nocore = { param = param_nocore, groupreg = groupreg,
122 :			errcons = errcons }
123 :	blume	327
124 :			fun main_compile arg = let
125 :	blume	335	val { rts, core, pervasive, primitives, binpaths } = arg
126 :	blume	327
127 :	blume	329	val ovldR = GenericVC.Control.overloadKW
128 :			val savedOvld = !ovldR
129 :			val _ = ovldR := true
130 :
131 :	blume	327	(* here we build a new gp -- the one that uses the freshly
132 :			* brewed pervasive env, core env, and primitives *)
133 :	blume	329	val core = valOf (RT.snode ginfo_nocore core)
134 :			val corenv = CoerceEnv.es2bs (#1 (#stat core))
135 :
136 :			(* The following is a bit of a hack (but corenv is a hack anyway):
137 :			* As soon as we have core available, we have to patch the
138 :			* ginfo to include the correct corenv (because virtually
139 :			* everybody else needs access to corenv). *)
140 :	blume	349	val param_justcore = mkInitParam { corenv = corenv }
141 :	blume	329	val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
142 :			errcons = errcons }
143 :
144 :			fun rt n = valOf (RT.snode ginfo_justcore n)
145 :	blume	327	val rts = rt rts
146 :			val pervasive = rt pervasive
147 :
148 :			fun sn2pspec (name, n) = let
149 :			val { stat = (s, sp), sym = (sy, syp), ctxt } = rt n
150 :			val env =
151 :			E.mkenv { static = s, symbolic = sy, dynamic = emptydyn }
152 :			val pidInfo = { statpid = sp, sympid = syp, ctxt = ctxt }
153 :			in
154 :			{ name = name, env = env, pidInfo = pidInfo }
155 :			end
156 :
157 :			val pspecs = map sn2pspec primitives
158 :
159 :	blume	329	val _ = ovldR := savedOvld
160 :
161 :	blume	349	val param =
162 :			mkParam { primconf = Primitive.configuration pspecs,
163 :	blume	327	pervasive = E.mkenv { static = #1 (#stat pervasive),
164 :			symbolic = #1 (#sym pervasive),
165 :			dynamic = emptydyn },
166 :			pervcorepids =
167 :			PidSet.addList (PidSet.empty,
168 :			[#2 (#stat pervasive),
169 :			#2 (#sym pervasive),
170 :			#2 (#stat core)]) }
171 :	blume	349	{ corenv = corenv }
172 :	blume	327	in
173 :	blume	331	case Parse.parse param NONE maingspec of
174 :	blume	349	NONE => false
175 :	blume	329	| SOME (g, gp) =>
176 :	blume	349	if recomp gp g then let
177 :			val rtspid = PS.toHex (#2 (#stat rts))
178 :			val bootfiles =
179 :			map (fn x => (x, NONE)) binpaths @
180 :			MkBootList.group g
181 :			fun writeList s = let
182 :			fun offset NONE = ["\n"]
183 :			| offset (SOME i) = ["@", Int.toString i, "\n"]
184 :			fun showBootFile (p, off) =
185 :			TextIO.output (s,
186 :			concat (AbsPath.name p
187 :			:: offset off))
188 :			in
189 :			app showBootFile bootfiles
190 :			end
191 :			in
192 :			Say.say ["Runtime System PID is: ", rtspid, "\n"];
193 :			SafeIO.perform { openIt = fn () =>
194 :			AbsPath.openTextOut pidfile,
195 :			closeIt = TextIO.closeOut,
196 :			work = fn s =>
197 :			TextIO.output (s, rtspid ^ "\n"),
198 :			cleanup = fn () =>
199 :			AbsPath.delete pidfile };
200 :			SafeIO.perform { openIt = fn () =>
201 :			AbsPath.openTextOut listfile,
202 :			closeIt = TextIO.closeOut,
203 :			work = writeList,
204 :			cleanup = fn () =>
205 :			AbsPath.delete listfile };
206 :			true
207 :			end
208 :			else false
209 :	blume	351	end handle Option => (RT.reset (); false)
210 :	blume	330	(* to catch valOf failures in "rt" *)
211 :	blume	327	in
212 :	blume	329	case BuildInitDG.build ginfo_nocore initgspec of
213 :	blume	327	SOME x => main_compile x
214 :	blume	349	| NONE => false
215 :	blume	327	end
216 :			end

---

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