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

Parent Directory | Revision Log

---

Revision 335 - (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 :
19 :			(* Since the bootstrap compiler never executes any of the code
20 :			* it produces, we don't need any dynamic values. Therefore,
21 :			* we create RecompPersstate (but not FullPersstate!) and
22 :			* instantiate Recomp as well as RecompTraversal.
23 :			* Since RecompPersstate is not part of any surrounding FullPersstate,
24 :			* function "discard_value" simply does nothing. *)
25 :			structure RecompPersstate =
26 :			RecompPersstateFn (structure MachDepVC = MachDepVC
27 :			val discard_code = true
28 :			fun discard_value (i: SmlInfo.info) = ())
29 :			structure Recomp = RecompFn (structure PS = RecompPersstate)
30 :			structure RT = CompileGenericFn (structure CT = Recomp)
31 :
32 :			fun recomp gp g = isSome (RT.group gp g)
33 :
34 :			(* instantiate Stabilize... *)
35 :	blume	329	structure Stabilize =
36 :			StabilizeFn (fun bn2statenv gp i = #1 (#stat (valOf (RT.bnode gp i)))
37 :			val recomp = recomp)
38 :	blume	327	(* ... and Parse *)
39 :			structure Parse = ParseFn (structure Stabilize = Stabilize)
40 :
41 :	blume	329	fun compile { binroot, pcmodespec, initgspec, maingspec } = let
42 :	blume	327
43 :	blume	329	val keep_going = EnvConfig.getSet StdConfig.keep_going NONE
44 :
45 :			val ctxt = AbsPath.cwdContext ()
46 :
47 :			val initgspec = AbsPath.native { context = ctxt, spec = initgspec }
48 :			val maingspec = AbsPath.native { context = ctxt, spec = maingspec }
49 :			val pcmodespec = AbsPath.native { context = ctxt, spec = pcmodespec }
50 :			val binroot = AbsPath.native { context = ctxt, spec = binroot }
51 :
52 :			fun build_pcmode () = let
53 :			val s = AbsPath.openTextIn pcmodespec
54 :			fun loop l = let
55 :			val line = TextIO.inputLine s
56 :			in
57 :			if line = "" then PathConfig.hardwire l
58 :			else case String.tokens Char.isSpace line of
59 :			[a, s] => loop ((a, s) :: l)
60 :			| _ => (Say.say [AbsPath.name pcmodespec,
61 :			": malformed line (ignored)\n"];
62 :			loop l)
63 :			end
64 :			in
65 :			loop [] before TextIO.closeIn s
66 :			end
67 :
68 :			val pcmode = build_pcmode ()
69 :
70 :			val fnpolicy =
71 :			FilenamePolicy.separate { root = binroot,
72 :			parentArc = "DOTDOT",
73 :			absArc = "ABSOLUTE" }
74 :			{ arch = MachDepVC.architecture, os = os }
75 :
76 :	blume	327	val emptydyn = E.dynamicPart E.emptyEnv
77 :
78 :			(* first, build an initial GeneralParam.info, so we can
79 :			* deal with the pervasive env and friends... *)
80 :			local
81 :			(* We could actually go and calculate the actual pid of primEnv.
82 :			* But in reality it's pretty pointless to do so... *)
83 :			val bogusPid = PS.fromBytes (Byte.stringToBytes "0123456789abcdef")
84 :			val pspec = { name = "primitive",
85 :			env = E.mkenv { static = E.primEnv,
86 :			symbolic = E.symbolicPart E.emptyEnv,
87 :			dynamic = emptydyn },
88 :			pidInfo = { statpid = bogusPid,
89 :			sympid = bogusPid,
90 :			ctxt = SE.empty } }
91 :			in
92 :			val primconf = Primitive.configuration [pspec]
93 :			end
94 :
95 :	blume	329	val param_nocore = { primconf = primconf,
96 :			fnpolicy = fnpolicy,
97 :			pcmode = pcmode,
98 :			keep_going = keep_going,
99 :			pervasive = E.emptyEnv,
100 :			corenv = BE.staticPart BE.emptyEnv,
101 :			pervcorepids = PidSet.empty }
102 :	blume	327
103 :			val groupreg = GroupReg.new ()
104 :			val errcons = EM.defaultConsumer ()
105 :	blume	329	val ginfo_nocore = { param = param_nocore, groupreg = groupreg,
106 :			errcons = errcons }
107 :	blume	327
108 :			fun main_compile arg = let
109 :	blume	335	val { rts, core, pervasive, primitives, binpaths } = arg
110 :	blume	327
111 :	blume	329	val ovldR = GenericVC.Control.overloadKW
112 :			val savedOvld = !ovldR
113 :			val _ = ovldR := true
114 :
115 :	blume	327	(* here we build a new gp -- the one that uses the freshly
116 :			* brewed pervasive env, core env, and primitives *)
117 :	blume	329	val core = valOf (RT.snode ginfo_nocore core)
118 :			val corenv = CoerceEnv.es2bs (#1 (#stat core))
119 :	blume	330	(* even though we have a pid for the core, we can't use it
120 :			* (otherwise we would invalidate earlier compilation results) *)
121 :			val pervcorepids = PidSet.empty
122 :	blume	329
123 :			(* The following is a bit of a hack (but corenv is a hack anyway):
124 :			* As soon as we have core available, we have to patch the
125 :			* ginfo to include the correct corenv (because virtually
126 :			* everybody else needs access to corenv). *)
127 :			val param_justcore = { primconf = primconf,
128 :			fnpolicy = fnpolicy,
129 :			pcmode = pcmode,
130 :			keep_going = keep_going,
131 :			pervasive = E.emptyEnv,
132 :			corenv = corenv,
133 :			pervcorepids = pervcorepids }
134 :			val ginfo_justcore = { param = param_justcore, groupreg = groupreg,
135 :			errcons = errcons }
136 :
137 :			fun rt n = valOf (RT.snode ginfo_justcore n)
138 :	blume	327	val rts = rt rts
139 :			val pervasive = rt pervasive
140 :
141 :			fun sn2pspec (name, n) = let
142 :			val { stat = (s, sp), sym = (sy, syp), ctxt } = rt n
143 :			val env =
144 :			E.mkenv { static = s, symbolic = sy, dynamic = emptydyn }
145 :			val pidInfo = { statpid = sp, sympid = syp, ctxt = ctxt }
146 :			in
147 :			{ name = name, env = env, pidInfo = pidInfo }
148 :			end
149 :
150 :			val pspecs = map sn2pspec primitives
151 :
152 :	blume	329	val _ = ovldR := savedOvld
153 :
154 :	blume	327	val param = { primconf = Primitive.configuration pspecs,
155 :			fnpolicy = fnpolicy,
156 :			pcmode = pcmode,
157 :			keep_going = keep_going,
158 :			pervasive = E.mkenv { static = #1 (#stat pervasive),
159 :			symbolic = #1 (#sym pervasive),
160 :			dynamic = emptydyn },
161 :			corenv = CoerceEnv.es2bs (#1 (#stat core)),
162 :			pervcorepids =
163 :			PidSet.addList (PidSet.empty,
164 :			[#2 (#stat pervasive),
165 :			#2 (#sym pervasive),
166 :			#2 (#stat core)]) }
167 :			in
168 :	blume	331	case Parse.parse param NONE maingspec of
169 :	blume	329	NONE => NONE
170 :			| SOME (g, gp) =>
171 :			if recomp gp g then
172 :			SOME { rtspid = PS.toHex (#2 (#stat rts)),
173 :			bootfiles =
174 :	blume	335	map (fn x => (x, NONE)) binpaths @
175 :	blume	329	MkBootList.group g }
176 :			else NONE
177 :	blume	330	end handle Option => (RT.clearFailures (); NONE)
178 :			(* to catch valOf failures in "rt" *)
179 :	blume	327	in
180 :	blume	329	case BuildInitDG.build ginfo_nocore initgspec of
181 :	blume	327	SOME x => main_compile x
182 :	blume	329	| NONE => NONE
183 :	blume	327	end
184 :			end

---

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