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

Parent Directory | Revision Log

---

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

---

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