1 |
(* COPYRIGHT (c) 1998 YALE FLINT PROJECT *) |
(* COPYRIGHT (c) 1998 YALE FLINT PROJECT *) |
2 |
(* flintcomp.sml *) |
(* flintcomp.sml *) |
3 |
|
|
4 |
functor FLINTComp (structure Gen: CPSGEN |
functor FLINTComp (structure Gen: MACHINE_GEN |
5 |
val collect: unit -> Word8Vector.vector) : CODEGENERATOR = |
val collect: unit -> CodeObj.code_object) : CODEGENERATOR = |
6 |
struct |
struct |
7 |
|
|
8 |
local structure CB = CompBasic |
local structure CB = CompBasic |
12 |
structure CPStrans = CPStrans(MachSpec) |
structure CPStrans = CPStrans(MachSpec) |
13 |
structure CPSopt = CPSopt(MachSpec) |
structure CPSopt = CPSopt(MachSpec) |
14 |
structure Closure = Closure(MachSpec) |
structure Closure = Closure(MachSpec) |
15 |
structure Spill = Spill(MachSpec) |
structure Spill = SpillFn(MachSpec) |
16 |
structure CpsSplit = CpsSplitFun (MachSpec) |
structure CpsSplit = CpsSplitFun (MachSpec) |
17 |
structure CTRL = FLINT_Control |
structure CTRL = FLINT_Control |
18 |
structure PP = PPFlint |
structure PP = PPFlint |
21 |
structure F = FLINT |
structure F = FLINT |
22 |
in |
in |
23 |
|
|
24 |
|
structure Machine = Gen |
25 |
val architecture = Gen.MachSpec.architecture |
val architecture = Gen.MachSpec.architecture |
26 |
fun bug s = ErrorMsg.impossible ("FLINTComp:" ^ s) |
fun bug s = ErrorMsg.impossible ("FLINTComp:" ^ s) |
27 |
val say = Control_Print.say |
val say = Control_Print.say |
55 |
val cpstrans = phase "Compiler 065 cpstrans" CPStrans.cpstrans |
val cpstrans = phase "Compiler 065 cpstrans" CPStrans.cpstrans |
56 |
val cpsopt = phase "Compiler 070 cpsopt" CPSopt.reduce |
val cpsopt = phase "Compiler 070 cpsopt" CPSopt.reduce |
57 |
val litsplit = phase "Compiler 075 litsplit" Literals.litsplit |
val litsplit = phase "Compiler 075 litsplit" Literals.litsplit |
58 |
val lit2cps = phase "Compiler 076 lit2cps" Literals.lit2cps |
val litToBytes = phase "Compiler 076 litToBytes" Literals.litToBytes |
59 |
val closure = phase "Compiler 080 closure" Closure.closeCPS |
val closure = phase "Compiler 080 closure" Closure.closeCPS |
60 |
val globalfix = phase "Compiler 090 globalfix" GlobalFix.globalfix |
val globalfix = phase "Compiler 090 globalfix" GlobalFix.globalfix |
61 |
val spill = if MachSpec.spillAreaSz < 500 * MachSpec.valueSize |
val spill = phase "Compiler 100 spill" Spill.spill |
|
then phase "Compiler 100 spill" Spill.spill |
|
|
else fn x => x |
|
62 |
val limit = phase "Compiler 110 limit" Limit.nolimit |
val limit = phase "Compiler 110 limit" Limit.nolimit |
63 |
val codegen = phase "Compiler 120 cpsgen" Gen.codegen |
val codegen = phase "Compiler 120 cpsgen" Gen.codegen |
64 |
|
|
|
val closureD = phase "Compiler 081 closureD" Closure.closeCPS |
|
|
val globalfixD= phase "Compiler 091 globalfixD" GlobalFix.globalfix |
|
|
val spillD = if MachSpec.spillAreaSz < 500 * MachSpec.valueSize |
|
|
then phase "Compiler 101 spillD" Spill.spill |
|
|
else fn x => x |
|
|
val limitD = phase "Compiler 110 limitD" Limit.nolimit |
|
|
val codegenD = phase "Compiler 121 cpsgenD" Gen.codegen |
|
|
|
|
65 |
(** pretty printing for the FLINT and CPS code *) |
(** pretty printing for the FLINT and CPS code *) |
66 |
val (prF, prC) = |
val (prF, prC) = |
67 |
let fun prGen (flag,printE) s e = |
let fun prGen (flag,printE) s e = |
195 |
val _ = prC "cpsopt" function |
val _ = prC "cpsopt" function |
196 |
|
|
197 |
val (function, dlit) = litsplit function |
val (function, dlit) = litsplit function |
198 |
val data = lit2cps dlit |
val data = litToBytes dlit |
199 |
val _ = prC "cpsopt-code" function |
val _ = prC "cpsopt-code" function |
|
val _ = prC "cpsopt-data" data |
|
200 |
|
|
201 |
|
(** NOTE: we should be passing the source-code name (src) to the |
202 |
|
** code generator somehow (for the second argument to code object allocation). |
203 |
|
**) |
204 |
fun gen fx = |
fun gen fx = |
205 |
let val fx = (prC "closure" o closure) fx |
let val fx = (prC "closure" o closure) fx |
206 |
val carg = globalfix fx |
val carg = globalfix fx |
210 |
collect () |
collect () |
211 |
end |
end |
212 |
|
|
|
fun gdata dd = |
|
|
let val x = Control.CG.printit |
|
|
val y = !x |
|
|
val _ = (x := false) |
|
|
val fx = (prC "closure" o closureD) dd |
|
|
val carg = globalfixD fx |
|
|
val carg = spillD carg |
|
|
val (carg, limit) = limitD carg |
|
|
in codegenD (carg, limit, err); |
|
|
(collect ()) before (x := y) |
|
|
end |
|
213 |
in case CpsSplit.cpsSplit function |
in case CpsSplit.cpsSplit function |
214 |
of (fun0 :: funn) => (gen fun0, map gen funn, gdata data) |
of (fun0 :: funn) => (gen fun0, map gen funn, data) |
215 |
| [] => bug "unexpected case on gen in flintcomp" |
| [] => bug "unexpected case on gen in flintcomp" |
216 |
end |
end |
217 |
in ({c0=nc0, cn=ncn, data=dseg, name=ref (SOME src)}, fi) |
in ({c0=nc0, cn=ncn, data=dseg}, fi) |
218 |
end (* function flintcomp *) |
end (* function flintcomp *) |
219 |
|
|
220 |
val flintcomp = phase "Compiler 050 flintcomp" flintcomp |
val flintcomp = phase "Compiler 050 flintcomp" flintcomp |
223 |
end (* structure FLINTComp *) |
end (* structure FLINTComp *) |
224 |
|
|
225 |
(* |
(* |
226 |
* $Log$ |
* $Log: flintcomp.sml,v $ |
227 |
|
* Revision 1.8 1999/01/11 16:53:25 george |
228 |
|
* new array representation support |
229 |
|
* |
230 |
*) |
*) |