Annotation of /sml/trunk/src/compiler/FLINT/main/flintcomp.sml

Parent Directory | Revision Log

---

Revision 191 - (view) (download)

1 :	monnier	16	(* COPYRIGHT (c) 1998 YALE FLINT PROJECT *)
2 :			(* flintcomp.sml *)
3 :
4 :			functor FLINTComp (structure Gen: CPSGEN
5 :			val collect: unit -> Word8Vector.vector) : CODEGENERATOR =
6 :			struct
7 :
8 :			local structure CB = CompBasic
9 :	monnier	122	(* structure CGC = Control.CG *)
10 :	monnier	16	structure MachSpec = Gen.MachSpec
11 :			structure Convert = Convert(MachSpec)
12 :			structure CPStrans = CPStrans(MachSpec)
13 :			structure CPSopt = CPSopt(MachSpec)
14 :	monnier	102	structure Closure = Closure(MachSpec)
15 :	monnier	16	structure Spill = Spill(MachSpec)
16 :			structure CpsSplit = CpsSplitFun (MachSpec)
17 :	monnier	162	structure CTRL = Control.FLINT
18 :	monnier	16	in
19 :
20 :			val architecture = Gen.MachSpec.architecture
21 :			fun bug s = ErrorMsg.impossible ("FLINTComp:" ^ s)
22 :			val say = Control.Print.say
23 :
24 :			fun phase x = Stats.doPhase (Stats.makePhase x)
25 :
26 :	monnier	184	val lcontract = phase "Compiler 052 lcontract" LContract.lcontract
27 :	monnier	164	val fcollect = phase "Compiler 052a fcollect" Collect.collect
28 :			val fcontract = phase "Compiler 052b fcontract" FContract.contract
29 :	monnier	191	val fcontract = fn f => (fcontract(fcollect f, Stats.newCounter[]))
30 :	monnier	164
31 :	monnier	191	val loopify = phase "Compiler 057 loopify" Loopify.loopify
32 :
33 :	monnier	71	val specialize= phase "Compiler 053 specialize" Specialize.specialize
34 :			val wrapping = phase "Compiler 054 wrapping" Wrapping.wrapping
35 :			val reify = phase "Compiler 055 reify" Reify.reify
36 :	monnier	122	val fixfix = phase "Compiler 056 fixfix" FixFix.fixfix
37 :	monnier	16
38 :	monnier	71	val convert = phase "Compiler 060 convert" Convert.convert
39 :			val cpstrans = phase "Compiler 065 cpstrans" CPStrans.cpstrans
40 :	monnier	16	val cpsopt = phase "Compiler 070 cpsopt" CPSopt.reduce
41 :	monnier	102	val litsplit = phase "Compiler 075 litsplit" Literals.litsplit
42 :			val lit2cps = phase "Compiler 076 lit2cps" Literals.lit2cps
43 :			val closure = phase "Compiler 080 closure" Closure.closeCPS
44 :	monnier	16	val globalfix = phase "Compiler 090 globalfix" GlobalFix.globalfix
45 :			val spill = if MachSpec.spillAreaSz < 500 * MachSpec.valueSize
46 :			then phase "Compiler 100 spill" Spill.spill
47 :			else fn x => x
48 :			val limit = phase "Compiler 110 limit" Limit.nolimit
49 :			val codegen = phase "Compiler 120 cpsgen" Gen.codegen
50 :
51 :	monnier	102	val closureD = phase "Compiler 081 closureD" Closure.closeCPS
52 :			val globalfixD= phase "Compiler 091 globalfixD" GlobalFix.globalfix
53 :			val spillD = if MachSpec.spillAreaSz < 500 * MachSpec.valueSize
54 :			then phase "Compiler 101 spillD" Spill.spill
55 :			else fn x => x
56 :			val limitD = phase "Compiler 110 limitD" Limit.nolimit
57 :			val codegenD = phase "Compiler 121 cpsgenD" Gen.codegen
58 :	monnier	16
59 :	monnier	71	(** pretty printing for the FLINT and CPS code *)
60 :			val (prF, prC) =
61 :			let fun prGen (flag,printE) s e =
62 :	monnier	102	if !flag then (say ("\n[After " ^ s ^ " ...]\n\n"); printE e;
63 :			say "\n"; e)
64 :	monnier	71	else e
65 :	monnier	162	in (prGen (CTRL.print, PPFlint.printProg),
66 :	monnier	122	prGen (Control.CG.printit, PPCps.printcps0))
67 :	monnier	71	end
68 :	monnier	16
69 :	monnier	71	(** writing out a term into a error output file *)
70 :			fun dumpTerm (printE, s, le) =
71 :			let val outS = TextIO.openAppend s;
72 :			val saveOut = !Control.Print.out
73 :			fun done () =
74 :			(TextIO.closeOut outS; Control.Print.out := saveOut)
75 :			in Control.Print.out := {say = fn s => TextIO.output(outS,s),
76 :			flush = fn () => TextIO.flushOut outS};
77 :			printE le handle x => (done () handle _ => (); raise x);
78 :			done ()
79 :			end (* function dumpTerm *)
80 :
81 :	monnier	189	val fcs : (FLINT.prog -> FLINT.prog) list ref = ref []
82 :
83 :	monnier	16	(** compiling FLINT code into the binary machine code *)
84 :			fun flintcomp(flint, compInfo as {error, sourceName=src, ...}: CB.compInfo) =
85 :			let fun err severity s =
86 :			error (0,0) severity (concat["Real constant out of range: ",s,"\n"])
87 :
88 :			fun check (checkE,printE,chkId) (enableChk,lvl,logId) e =
89 :			(if !enableChk andalso checkE (e,lvl) then
90 :	monnier	71	(dumpTerm (printE, src ^ "." ^ chkId ^ logId, e);
91 :			bug (chkId ^ " typing errors " ^ logId))
92 :	monnier	16	else ();
93 :			e)
94 :	monnier	71	fun chkF (b, s) =
95 :			check (ChkFlint.checkTop, PPFlint.printFundec,
96 :	monnier	162	"FLINT") (CTRL.check, b, s)
97 :	monnier	16
98 :	monnier	189	val fcing = ref (!fcs)
99 :
100 :			(* fun fcontract f =
101 :			case !fcing
102 :			of fcontract::fcs => (fcing := fcs; fcontract f)
103 :			| [] => let val fcc = Stats.newCounter[]
104 :			val fcname = "FContract-"^(Int.toString(length(!fcs)))
105 :			val coname = "FCollect-"^(Int.toString(length(!fcs)))
106 :			val lcname = "LContract-"^(Int.toString(length(!fcs)))
107 :			val fcstat = Stats.newStat(fcname, [fcc])
108 :			val fcphase = phase ("Compiler 052b "^fcname)
109 :			FContract.contract
110 :			val cophase = phase ("Compiler 052a "^coname)
111 :			Collect.collect
112 :			val lcphase = phase ("Compiler 052 "^lcname)
113 :			LContract.lcontract
114 :			fun g c = (lcphase c; fcphase(cophase c,fcc))
115 :			in
116 :			Stats.registerStat fcstat;
117 :			fcs := (!fcs) @ [g];
118 :			g f
119 :			end *)
120 :
121 :	monnier	162	(* f:FLINT.prog flint codee
122 :			* r:boot whether it has gone through reify yet
123 :			* l:string last phase through which it went *)
124 :			fun runphase (p as "fcontract",(f,r,l)) = (fcontract f, r, p)
125 :	monnier	184	| runphase (p as "lcontract",(f,r,l)) = (lcontract f, r, p)
126 :	monnier	162	| runphase (p as "fixfix",(f,r,l)) = (fixfix f, r, p)
127 :	monnier	191	| runphase (p as "loopify",(f,r,l)) = (loopify f, r, p)
128 :	monnier	162	| runphase (p as "wrap",(f,false,l)) = (wrapping f, false, p)
129 :			| runphase (p as "specialize",(f,false,l)) = (specialize f, false, p)
130 :			| runphase (p as "reify",(f,false,l)) = (reify f, true, p)
131 :	monnier	122
132 :	monnier	162	(* pseudo FLINT phases *)
133 :			| runphase ("id",(f,r,l)) = (f,r,l)
134 :	monnier	186	| runphase (p as "collect",(f,r,l)) = (fcollect f, r, p)
135 :	monnier	162	| runphase (p as "print",(f,r,l)) =
136 :	monnier	163	(say("\n[ After "^l^"... ]\n\n");
137 :			PPFlint.printFundec f; (f,r,l)
138 :			before say "\n")
139 :	monnier	162	| runphase ("check",(f,r,l)) =
140 :			(check (ChkFlint.checkTop, PPFlint.printFundec, "FLINT")
141 :			(ref true, r, l) f; (f,r,l))
142 :			| runphase (p as ("reify"|"specialize"|"wrap"),(f,true,l)) =
143 :			(say("\n"^p^"cannot be used after reify!\n"); (f,true,l))
144 :			| runphase (p,(f,r,l)) =
145 :			(say("\n!! Unknown FLINT phase '"^p^"' !!\n"); (f,r,l))
146 :	monnier	16
147 :	monnier	162	fun print (f,r,l) = (prF l f; (f, r, l))
148 :			fun check (f,r,l) = (chkF (r, l) f; (f, r, l))
149 :
150 :	monnier	184	fun runphase' (arg as (p,{1=f,...})) =
151 :	monnier	189	(if !CTRL.printPhases then say("Phase "^p^"...") else ();
152 :			((check o print o runphase) arg) before
153 :			(if !CTRL.printPhases then say("..."^p^" Done.\n") else ()))
154 :			handle x => (say ("\nwhile in "^p^" phase\n");
155 :	monnier	185	dumpTerm(PPFlint.printFundec,"FLINT.core", f);
156 :			raise x)
157 :	monnier	163
158 :	monnier	191	(* the "id" phase is just added to do the print/check at the entrance *)
159 :	monnier	189	val (flint,r,_) = foldl runphase'
160 :	monnier	163	(flint,false,"flintnm")
161 :	monnier	184	((* "id" :: *) !CTRL.phases)
162 :	monnier	163	val flint = if r then flint else (say "\n!!Forgot reify!!\n"; reify flint)
163 :	monnier	162
164 :			(* val _ = (chkF (false,"1") o prF "Translation/Normalization") flint *)
165 :			(* val flint = (chkF (false,"2") o prF "Fcontract" o fcontract) flint *)
166 :
167 :			(* val flint = *)
168 :			(* if !Control.FLINT.specialize then *)
169 :			(* (chkF (false,"3") o prF "Specialization" o specialize) flint *)
170 :			(* else flint *)
171 :			(* val flint = (chkF (false,"2") o prF "Fcontract" o fcontract) flint *)
172 :
173 :	monnier	122	(* val flint = (chkF (false,"6") o prF "FixFix" o fixfix) flint *)
174 :	monnier	162	(* val flint = (chkF (false,"2") o prF "Fcontract" o fcontract) flint *)
175 :	monnier	122
176 :	monnier	162	(* val flint = (chkF (false, "4") o prF "Wrapping" o wrapping) flint *)
177 :			(* val flint = (chkF (true, "5") o prF "Reify" o reify) flint *)
178 :	monnier	102
179 :	monnier	162	(* val flint = (chkF (true,"2") o prF "Fcontract" o fcontract) flint *)
180 :	monnier	122
181 :	monnier	102	val (nc0, ncn, dseg) =
182 :			let val function = convert flint
183 :			val _ = prC "convert" function
184 :	monnier	71	val function = (prC "cpstrans" o cpstrans) function
185 :	monnier	162	val function = cpsopt (function,NONE,false)
186 :	monnier	71	val _ = prC "cpsopt" function
187 :	monnier	45
188 :	monnier	102	val (function, dlit) = litsplit function
189 :			val data = lit2cps dlit
190 :			val _ = prC "cpsopt-code" function
191 :			val _ = prC "cpsopt-data" data
192 :
193 :	monnier	71	fun gen fx =
194 :			let val fx = (prC "closure" o closure) fx
195 :			val carg = globalfix fx
196 :			val carg = spill carg
197 :			val (carg, limit) = limit carg
198 :			in codegen (carg, limit, err);
199 :			collect ()
200 :			end
201 :	monnier	102
202 :			fun gdata dd =
203 :			let val x = Control.CG.printit
204 :			val y = !x
205 :			val _ = (x := false)
206 :			val fx = (prC "closure" o closureD) dd
207 :			val carg = globalfixD fx
208 :			val carg = spillD carg
209 :			val (carg, limit) = limitD carg
210 :			in codegenD (carg, limit, err);
211 :			(collect ()) before (x := y)
212 :			end
213 :	monnier	71	in case CpsSplit.cpsSplit function
214 :	monnier	102	of (fun0 :: funn) => (gen fun0, map gen funn, gdata data)
215 :	monnier	71	| [] => bug "unexpected case on gen in flintcomp"
216 :			end
217 :	monnier	102	in {c0=nc0, cn=ncn, data=dseg, name=ref (SOME src)}
218 :	monnier	16	end (* function flintcomp *)
219 :
220 :	monnier	71	val flintcomp = phase "Compiler 050 flintcomp" flintcomp
221 :	monnier	16
222 :			end (* local *)
223 :			end (* structure FLINTComp *)
224 :	monnier	95
225 :			(*
226 :	monnier	118	* $Log$
227 :	monnier	95	*)

---

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