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

Parent Directory | Revision Log

---

Revision 352 - (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 pcmodespec = AbsPath.native { context = ctxt, spec = pcmodespec }
50 :			val binroot = AbsPath.native { context = ctxt, spec = binroot }
51 :	blume	349	val pidfile = AbsPath.joinDirFile { dir = binroot, file = "RTPID" }
52 :			val listfile = AbsPath.joinDirFile { dir = binroot, file = "BINLIST" }
53 :	blume	329
54 :	blume	344	val pcmode = let
55 :	blume	345	fun work s = let
56 :			fun loop l = let
57 :			val line = TextIO.inputLine s
58 :			in
59 :			if line = "" then PathConfig.hardwire l
60 :			else case String.tokens Char.isSpace line of
61 :			[a, s] => loop ((a, s) :: l)
62 :			| _ => (Say.say [AbsPath.name pcmodespec,
63 :			": malformed line (ignored)\n"];
64 :			loop l)
65 :			end
66 :	blume	329	in
67 :	blume	345	loop []
68 :	blume	329	end
69 :			in
70 :	blume	345	SafeIO.perform { openIt = fn () => AbsPath.openTextIn pcmodespec,
71 :			closeIt = TextIO.closeIn,
72 :			work = work,
73 :			cleanup = fn () => () }
74 :	blume	329	end
75 :
76 :	blume	352	fun stdpath s = AbsPath.standard pcmode { context = ctxt, spec = s }
77 :
78 :			val initgspec = stdpath initgspec
79 :			val maingspec = stdpath maingspec
80 :
81 :	blume	329	val fnpolicy =
82 :	blume	352	FilenamePolicy.separate binroot
83 :			{ arch = MachDepVC.architecture, os = os }
84 :	blume	329
85 :	blume	349	fun mkParam { primconf, pervasive, pervcorepids } { corenv } =
86 :			{ primconf = primconf,
87 :			fnpolicy = fnpolicy,
88 :			pcmode = pcmode,
89 :			symenv = SSV.env,
90 :			keep_going = keep_going,
91 :			pervasive = pervasive,
92 :			corenv = corenv,
93 :			pervcorepids = pervcorepids }
94 :
95 :	blume	327	val emptydyn = E.dynamicPart E.emptyEnv
96 :
97 :			(* first, build an initial GeneralParam.info, so we can
98 :			* deal with the pervasive env and friends... *)
99 :			local
100 :			(* We could actually go and calculate the actual pid of primEnv.
101 :			* But in reality it's pretty pointless to do so... *)
102 :			val bogusPid = PS.fromBytes (Byte.stringToBytes "0123456789abcdef")
103 :			val pspec = { name = "primitive",
104 :			env = E.mkenv { static = E.primEnv,
105 :			symbolic = E.symbolicPart E.emptyEnv,
106 :			dynamic = emptydyn },
107 :			pidInfo = { statpid = bogusPid,
108 :			sympid = bogusPid,
109 :			ctxt = SE.empty } }
110 :			in
111 :			val primconf = Primitive.configuration [pspec]
112 :			end
113 :
114 :	blume	349	val mkInitParam = mkParam { primconf = primconf,
115 :			pervasive = E.emptyEnv,
116 :			pervcorepids = PidSet.empty }
117 :	blume	327
118 :	blume	349	val param_nocore = mkInitParam { corenv = BE.staticPart BE.emptyEnv }
119 :
120 :	blume	327	val groupreg = GroupReg.new ()
121 :			val errcons = EM.defaultConsumer ()
122 :	blume	329	val ginfo_nocore = { param = param_nocore, groupreg = groupreg,
123 :			errcons = errcons }
124 :	blume	327
125 :			fun main_compile arg = let
126 :	blume	335	val { rts, core, pervasive, primitives, binpaths } = arg
127 :	blume	327
128 :	blume	329	val ovldR = GenericVC.Control.overloadKW
129 :			val savedOvld = !ovldR
130 :			val _ = ovldR := true
131 :
132 :	blume	327	(* here we build a new gp -- the one that uses the freshly
133 :			* brewed pervasive env, core env, and primitives *)
134 :	blume	329	val core = valOf (RT.snode ginfo_nocore core)
135 :			val corenv = CoerceEnv.es2bs (#1 (#stat core))
136 :
137 :			(* The following is a bit of a hack (but corenv is a hack anyway):
138 :			* As soon as we have core available, we have to patch the
139 :			* ginfo to include the correct corenv (because virtually
140 :			* everybody else needs access to corenv). *)
141 :	blume	349	val param_justcore = mkInitParam { corenv = corenv }
142 :	blume	329	val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
143 :			errcons = errcons }
144 :
145 :			fun rt n = valOf (RT.snode ginfo_justcore n)
146 :	blume	327	val rts = rt rts
147 :			val pervasive = rt pervasive
148 :
149 :			fun sn2pspec (name, n) = let
150 :			val { stat = (s, sp), sym = (sy, syp), ctxt } = rt n
151 :			val env =
152 :			E.mkenv { static = s, symbolic = sy, dynamic = emptydyn }
153 :			val pidInfo = { statpid = sp, sympid = syp, ctxt = ctxt }
154 :			in
155 :			{ name = name, env = env, pidInfo = pidInfo }
156 :			end
157 :
158 :			val pspecs = map sn2pspec primitives
159 :
160 :	blume	329	val _ = ovldR := savedOvld
161 :
162 :	blume	349	val param =
163 :			mkParam { primconf = Primitive.configuration pspecs,
164 :	blume	327	pervasive = E.mkenv { static = #1 (#stat pervasive),
165 :			symbolic = #1 (#sym pervasive),
166 :			dynamic = emptydyn },
167 :			pervcorepids =
168 :			PidSet.addList (PidSet.empty,
169 :			[#2 (#stat pervasive),
170 :			#2 (#sym pervasive),
171 :			#2 (#stat core)]) }
172 :	blume	349	{ corenv = corenv }
173 :	blume	327	in
174 :	blume	331	case Parse.parse param NONE maingspec of
175 :	blume	349	NONE => false
176 :	blume	329	| SOME (g, gp) =>
177 :	blume	349	if recomp gp g then let
178 :			val rtspid = PS.toHex (#2 (#stat rts))
179 :			val bootfiles =
180 :			map (fn x => (x, NONE)) binpaths @
181 :			MkBootList.group g
182 :			fun writeList s = let
183 :			fun offset NONE = ["\n"]
184 :			| offset (SOME i) = ["@", Int.toString i, "\n"]
185 :			fun showBootFile (p, off) =
186 :			TextIO.output (s,
187 :			concat (AbsPath.name p
188 :			:: offset off))
189 :			in
190 :			app showBootFile bootfiles
191 :			end
192 :			in
193 :			Say.say ["Runtime System PID is: ", rtspid, "\n"];
194 :			SafeIO.perform { openIt = fn () =>
195 :			AbsPath.openTextOut pidfile,
196 :			closeIt = TextIO.closeOut,
197 :			work = fn s =>
198 :			TextIO.output (s, rtspid ^ "\n"),
199 :			cleanup = fn () =>
200 :			AbsPath.delete pidfile };
201 :			SafeIO.perform { openIt = fn () =>
202 :			AbsPath.openTextOut listfile,
203 :			closeIt = TextIO.closeOut,
204 :			work = writeList,
205 :			cleanup = fn () =>
206 :			AbsPath.delete listfile };
207 :			true
208 :			end
209 :			else false
210 :	blume	351	end handle Option => (RT.reset (); false)
211 :	blume	330	(* to catch valOf failures in "rt" *)
212 :	blume	327	in
213 :	blume	329	case BuildInitDG.build ginfo_nocore initgspec of
214 :	blume	327	SOME x => main_compile x
215 :	blume	349	| NONE => false
216 :	blume	327	end
217 :			end

---

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