Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/FLINT/main/flintcomp.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 189 - (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 189 val fcontract = fn f => (lcontract f; fcontract(fcollect f, Stats.newCounter[]))
30 : monnier 164
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 189 val fcs : (FLINT.prog -> FLINT.prog) list ref = ref []
80 :    
81 : monnier 16 (** compiling FLINT code into the binary machine code *)
82 :     fun flintcomp(flint, compInfo as {error, sourceName=src, ...}: CB.compInfo) =
83 :     let fun err severity s =
84 :     error (0,0) severity (concat["Real constant out of range: ",s,"\n"])
85 :    
86 :     fun check (checkE,printE,chkId) (enableChk,lvl,logId) e =
87 :     (if !enableChk andalso checkE (e,lvl) then
88 : monnier 71 (dumpTerm (printE, src ^ "." ^ chkId ^ logId, e);
89 :     bug (chkId ^ " typing errors " ^ logId))
90 : monnier 16 else ();
91 :     e)
92 : monnier 71 fun chkF (b, s) =
93 :     check (ChkFlint.checkTop, PPFlint.printFundec,
94 : monnier 162 "FLINT") (CTRL.check, b, s)
95 : monnier 16
96 : monnier 189 val fcing = ref (!fcs)
97 :    
98 :     (* fun fcontract f =
99 :     case !fcing
100 :     of fcontract::fcs => (fcing := fcs; fcontract f)
101 :     | [] => let val fcc = Stats.newCounter[]
102 :     val fcname = "FContract-"^(Int.toString(length(!fcs)))
103 :     val coname = "FCollect-"^(Int.toString(length(!fcs)))
104 :     val lcname = "LContract-"^(Int.toString(length(!fcs)))
105 :     val fcstat = Stats.newStat(fcname, [fcc])
106 :     val fcphase = phase ("Compiler 052b "^fcname)
107 :     FContract.contract
108 :     val cophase = phase ("Compiler 052a "^coname)
109 :     Collect.collect
110 :     val lcphase = phase ("Compiler 052 "^lcname)
111 :     LContract.lcontract
112 :     fun g c = (lcphase c; fcphase(cophase c,fcc))
113 :     in
114 :     Stats.registerStat fcstat;
115 :     fcs := (!fcs) @ [g];
116 :     g f
117 :     end *)
118 :    
119 : monnier 162 (* f:FLINT.prog flint codee
120 :     * r:boot whether it has gone through reify yet
121 :     * l:string last phase through which it went *)
122 :     fun runphase (p as "fcontract",(f,r,l)) = (fcontract f, r, p)
123 : monnier 184 | runphase (p as "lcontract",(f,r,l)) = (lcontract f, r, p)
124 : monnier 162 | runphase (p as "fixfix",(f,r,l)) = (fixfix f, r, p)
125 :     | runphase (p as "wrap",(f,false,l)) = (wrapping f, false, p)
126 :     | runphase (p as "specialize",(f,false,l)) = (specialize f, false, p)
127 :     | runphase (p as "reify",(f,false,l)) = (reify f, true, p)
128 : monnier 122
129 : monnier 162 (* pseudo FLINT phases *)
130 :     | runphase ("id",(f,r,l)) = (f,r,l)
131 : monnier 186 | runphase (p as "collect",(f,r,l)) = (fcollect f, r, p)
132 : monnier 162 | runphase (p as "print",(f,r,l)) =
133 : monnier 163 (say("\n[ After "^l^"... ]\n\n");
134 :     PPFlint.printFundec f; (f,r,l)
135 :     before say "\n")
136 : monnier 162 | runphase ("check",(f,r,l)) =
137 :     (check (ChkFlint.checkTop, PPFlint.printFundec, "FLINT")
138 :     (ref true, r, l) f; (f,r,l))
139 :     | runphase (p as ("reify"|"specialize"|"wrap"),(f,true,l)) =
140 :     (say("\n"^p^"cannot be used after reify!\n"); (f,true,l))
141 :     | runphase (p,(f,r,l)) =
142 :     (say("\n!! Unknown FLINT phase '"^p^"' !!\n"); (f,r,l))
143 : monnier 16
144 : monnier 162 fun print (f,r,l) = (prF l f; (f, r, l))
145 :     fun check (f,r,l) = (chkF (r, l) f; (f, r, l))
146 :    
147 : monnier 184 fun runphase' (arg as (p,{1=f,...})) =
148 : monnier 189 (if !CTRL.printPhases then say("Phase "^p^"...") else ();
149 :     ((check o print o runphase) arg) before
150 :     (if !CTRL.printPhases then say("..."^p^" Done.\n") else ()))
151 :     handle x => (say ("\nwhile in "^p^" phase\n");
152 : monnier 185 dumpTerm(PPFlint.printFundec,"FLINT.core", f);
153 :     raise x)
154 : monnier 163
155 : monnier 162 (* the "id" phases is just added to do the print/check at the entrance *)
156 : monnier 189 val (flint,r,_) = foldl runphase'
157 : monnier 163 (flint,false,"flintnm")
158 : monnier 184 ((* "id" :: *) !CTRL.phases)
159 : monnier 163 val flint = if r then flint else (say "\n!!Forgot reify!!\n"; reify flint)
160 : monnier 162
161 :     (* val _ = (chkF (false,"1") o prF "Translation/Normalization") flint *)
162 :     (* val flint = (chkF (false,"2") o prF "Fcontract" o fcontract) flint *)
163 :    
164 :     (* val flint = *)
165 :     (* if !Control.FLINT.specialize then *)
166 :     (* (chkF (false,"3") o prF "Specialization" o specialize) flint *)
167 :     (* else flint *)
168 :     (* val flint = (chkF (false,"2") o prF "Fcontract" o fcontract) flint *)
169 :    
170 : monnier 122 (* val flint = (chkF (false,"6") o prF "FixFix" o fixfix) flint *)
171 : monnier 162 (* val flint = (chkF (false,"2") o prF "Fcontract" o fcontract) flint *)
172 : monnier 122
173 : monnier 162 (* val flint = (chkF (false, "4") o prF "Wrapping" o wrapping) flint *)
174 :     (* val flint = (chkF (true, "5") o prF "Reify" o reify) flint *)
175 : monnier 102
176 : monnier 162 (* val flint = (chkF (true,"2") o prF "Fcontract" o fcontract) flint *)
177 : monnier 122
178 : monnier 102 val (nc0, ncn, dseg) =
179 :     let val function = convert flint
180 :     val _ = prC "convert" function
181 : monnier 71 val function = (prC "cpstrans" o cpstrans) function
182 : monnier 162 val function = cpsopt (function,NONE,false)
183 : monnier 71 val _ = prC "cpsopt" function
184 : monnier 45
185 : monnier 102 val (function, dlit) = litsplit function
186 :     val data = lit2cps dlit
187 :     val _ = prC "cpsopt-code" function
188 :     val _ = prC "cpsopt-data" data
189 :    
190 : monnier 71 fun gen fx =
191 :     let val fx = (prC "closure" o closure) fx
192 :     val carg = globalfix fx
193 :     val carg = spill carg
194 :     val (carg, limit) = limit carg
195 :     in codegen (carg, limit, err);
196 :     collect ()
197 :     end
198 : monnier 102
199 :     fun gdata dd =
200 :     let val x = Control.CG.printit
201 :     val y = !x
202 :     val _ = (x := false)
203 :     val fx = (prC "closure" o closureD) dd
204 :     val carg = globalfixD fx
205 :     val carg = spillD carg
206 :     val (carg, limit) = limitD carg
207 :     in codegenD (carg, limit, err);
208 :     (collect ()) before (x := y)
209 :     end
210 : monnier 71 in case CpsSplit.cpsSplit function
211 : monnier 102 of (fun0 :: funn) => (gen fun0, map gen funn, gdata data)
212 : monnier 71 | [] => bug "unexpected case on gen in flintcomp"
213 :     end
214 : monnier 102 in {c0=nc0, cn=ncn, data=dseg, name=ref (SOME src)}
215 : monnier 16 end (* function flintcomp *)
216 :    
217 : monnier 71 val flintcomp = phase "Compiler 050 flintcomp" flintcomp
218 : monnier 16
219 :     end (* local *)
220 :     end (* structure FLINTComp *)
221 : monnier 95
222 :     (*
223 : monnier 118 * $Log$
224 : monnier 95 *)

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