SCM Repository
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 |