1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
(*
* Generate the <arch>RTLProps functor.
* This structure extracts semantics and dependence
* information about the instruction set needed for SSA optimizations.
*)
functor MDLGenRTLProps(RTLComp : MDL_RTL_COMP) : MDL_GEN_MODULE2 =
struct
structure RTLComp = RTLComp
structure Comp = RTLComp.Comp
structure M = RTLComp.MLRiscTypes
structure Consts = Comp.Consts
structure Ast = Comp.Ast
structure Env = Comp.Env
structure Tr = Comp.Trans
structure RTL = RTLComp.RTL
structure T = RTL.T
structure C = CellsBasis
open Ast Comp.Util Comp.Error
exception Undefined
exception NotFound
(* Function to make a new RTL *)
val makeNewRTL = IDexp(IDENT(["RTL"],"new"))
(*------------------------------------------------------------------------
*
* Generate a table of compiled RTLs templates
*
*------------------------------------------------------------------------*)
fun genRTLTable compiled_rtls =
let val md = RTLComp.md compiled_rtls
val rtls = RTLComp.rtls compiled_rtls
val rtlStrName = Comp.strname md "RTL"
val constTbl = Consts.newConstTable()
fun makeEntry(RTLComp.RTLDEF{id, args, rtl, ...}) =
let val lookup = RTL.argOf rtl
fun param i = APPexp(IDexp(IDENT(["T"],"PARAM")),INTexp i)
fun makeArg name =
let val (exp,pos) = lookup name
val e =
case pos of
RTL.IN i => param i
| RTL.OUT i => param i
| RTL.IO(i,_) => param i
in (name, e)
end handle RTL.NotAnArgument =>
(warning("'"^name^"' is unused in rtl "^id);
(name,param 0)
)
val arg = Consts.const constTbl (RECORDexp(map makeArg args))
in VALdecl[VALbind(IDpat id,
APPexp(makeNewRTL,
APPexp(IDexp(IDENT([rtlStrName],id)),
arg)))
]
end
val body = map makeEntry rtls
in STRUCTUREdecl("Arch",[],
NONE,DECLsexp
[LOCALdecl(Comp.Consts.genConsts constTbl,body)
])
end
(*------------------------------------------------------------------------
*
* Create the function rtl : instruction -> rtl
*
*------------------------------------------------------------------------*)
fun mkRtlQueryFun compiled_rtls =
let fun body{instr, rtl=RTLComp.RTLDEF{id,...}, const} =
{exp=IDexp(IDENT(["Arch"],id)), casePats=[]}
in RTLComp.mkQuery compiled_rtls
{name = "rtl",
namedArguments= true,
args = [["instr"]],
decls = [RTLComp.complexErrorHandler "rtl"],
caseArgs = [],
body = body
}
end
(*------------------------------------------------------------------------
*
* Create the function defUse : instruction -> cell list * cell list
*
*------------------------------------------------------------------------*)
fun mkDefUseQueryFun compiled_rtls name =
let val {get, decl} = M.getOpnd
[("int", M.CONV("CELL(int x)")),
("int32", M.CONV("CELL(int32 x)")),
("intinf", M.CONV("CELL(intinf x)")),
("word", M.CONV("CELL(word x)")),
("word32", M.CONV("CELL(word32 x)")),
("cell", M.CONV("CELL x")),
("label", M.IGNORE),
("cellset", M.MULTI("map CELL (CellsBasis.CellSet.toCellList x)")),
("operand", M.CONV("OPERAND x"))
]
val decl0 =
$["(* methods for computing value numbers *)",
"val OT.VALUE_NUMBERING",
" {int, int32, intinf, word, word32, operand, ...} =",
" valueNumberingMethods",
"(* methods for type conversion *)"
]
fun gen x = SOME(get x)
in RTLComp.mkDefUseQuery
compiled_rtls
{name = name,
args = [["valueNumberingMethods"], ["instr"]],
namedArguments = false,
decls = [RTLComp.complexErrorHandler name, decl0, decl],
def = gen,
use = gen
}
end
(*------------------------------------------------------------------------
*
* Main routine
*
*------------------------------------------------------------------------*)
fun gen compiled_rtls =
let (* The machine description *)
val md = RTLComp.md compiled_rtls
(* name of the structure/signature *)
val strName = Comp.strname md "RTLProps"
val sigName = "RTL_PROPERTIES"
(* Arguments to the instruction functor *)
val args =
["structure Instr : "^Comp.signame md "INSTR",
"structure RegionProps : REGION_PROPERTIES",
"structure RTL : MLTREE_RTL",
"structure OperandTable : OPERAND_TABLE where I = Instr",
"structure Asm : INSTRUCTION_EMITTER where I = Instr",
" sharing Instr.T = RTL.T"
]
(* The functor *)
val strBody =
[$ ["structure I = Instr",
"structure C = I.C",
"structure RTL = RTL",
"structure T = RTL.T",
"structure OT = OperandTable",
"",
"datatype value = CELL of C.cell",
" | OPERAND of I.operand",
""
],
Comp.errorHandler md "RTLProps",
RTLComp.complexErrorHandlerDef (),
STRUCTUREdecl(Comp.strname md "RTL",[],NONE,
APPsexp(IDsexp(IDENT([],Comp.strname md "RTL")),
DECLsexp[
$[ "structure RTL = RTL",
"structure C = C"
]]
)
),
genRTLTable compiled_rtls,
mkRtlQueryFun compiled_rtls,
mkDefUseQueryFun compiled_rtls "defUse"
]
in Comp.codegen md "mltree/RTLProps"
[Comp.mkFct md "RTLProps" args sigName
(map Tr.simplifyDecl strBody)
]
end
end
|
