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/MLRISC/Tools/MDL/mdl-rtl-tools.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/Tools/MDL/mdl-rtl-tools.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 775 - (view) (download)

1 : leunga 744 (*
2 :     * Process rtl descriptions
3 :     *)
4 :     functor MDLRTLTools
5 :     (structure AstUtil : MDL_AST_UTIL
6 :     structure MLTreeRTL : MLTREE_RTL
7 :     ) : MDL_RTL_TOOLS =
8 :     struct
9 :     structure Ast = AstUtil.Ast
10 :     structure RTL = MLTreeRTL
11 :     structure T = RTL.T
12 :     structure A = Ast
13 :     structure U = AstUtil
14 :     structure CellsBasis = CellsBasis
15 :    
16 :     fun error msg = MLRiscErrorMsg.error("MDRTLTools",msg)
17 :    
18 :     (*========================================================================
19 :     *
20 :     * Simplify an RTL expression
21 :     *
22 :     *========================================================================*)
23 :     fun simplify rtl =
24 :     let fun stm reduce (T.SEQ [s]) = s
25 :     | stm reduce (T.IF(T.TRUE, y, n)) = y
26 :     | stm reduce (T.IF(T.FALSE, y, n)) = n
27 :     | stm reduce s = s
28 :    
29 : leunga 775 and (* rexp reduce (T.ADD(_,T.LI 0,x)) = x
30 : leunga 744 | rexp reduce (T.ADD(_,x,T.LI 0)) = x
31 :     | rexp reduce (T.SUB(_,x,T.LI 0)) = x
32 :     | rexp reduce (T.MULS(_,_,zero as T.LI 0)) = zero
33 :     | rexp reduce (T.MULU(_,_,zero as T.LI 0)) = zero
34 :     | rexp reduce (T.MULT(_,_,zero as T.LI 0)) = zero
35 :     | rexp reduce (T.MULS(_,zero as T.LI 0, _)) = zero
36 :     | rexp reduce (T.MULU(_,zero as T.LI 0, _)) = zero
37 :     | rexp reduce (T.MULT(_,zero as T.LI 0, _)) = zero
38 :     | rexp reduce (T.MULS(_,x,T.LI 1)) = x
39 :     | rexp reduce (T.MULU(_,x,T.LI 1)) = x
40 :     | rexp reduce (T.MULT(_,x,T.LI 1)) = x
41 :     | rexp reduce (T.DIVS(_,x,T.LI 1)) = x
42 :     | rexp reduce (T.DIVU(_,x,T.LI 1)) = x
43 :     | rexp reduce (T.DIVT(_,x,T.LI 1)) = x
44 :     | rexp reduce (T.ANDB(_,_,zero as T.LI 0)) = zero
45 : leunga 775 | rexp reduce (T.ANDB(_,zero as T.LI 0,_)) = zero
46 :     | *) rexp reduce (e as T.ANDB(_,x,y)) =
47 : leunga 744 if RTL.Util.eqRexp(x,y) then x else e
48 : leunga 775 (* | rexp reduce (T.ORB(_,x,T.LI 0)) = x
49 :     | rexp reduce (T.ORB(_,T.LI 0,x)) = x *)
50 : leunga 744 | rexp reduce (e as T.ORB(_,x,y)) =
51 :     if RTL.Util.eqRexp(x,y) then x else e
52 :     | rexp reduce (T.NOTB(_,T.NOTB(_,x))) = x
53 :     | rexp reduce (e as T.SX(t1,t2,x)) = if t1 = t2 then x else e
54 :     | rexp reduce (e as T.ZX(t1,t2,x)) = if t1 = t2 then x else e
55 :     | rexp reduce e = e
56 :     and fexp reduce e = e
57 :    
58 :     and ccexp reduce (T.NOT T.TRUE) = T.FALSE
59 :     | ccexp reduce (T.NOT T.FALSE) = T.TRUE
60 :     | ccexp reduce (T.AND(T.FALSE,_)) = T.FALSE
61 :     | ccexp reduce (T.AND(_,T.FALSE)) = T.FALSE
62 :     | ccexp reduce (T.AND(T.TRUE, x)) = x
63 :     | ccexp reduce (T.AND(x,T.TRUE)) = x
64 :     | ccexp reduce (T.OR(T.FALSE,x)) = x
65 :     | ccexp reduce (T.OR(x,T.FALSE)) = x
66 :     | ccexp reduce (T.OR(T.TRUE, _)) = T.TRUE
67 :     | ccexp reduce (T.OR(_,T.TRUE)) = T.TRUE
68 :     | ccexp reduce (e as T.CMP(_,T.EQ,x,y)) =
69 :     if RTL.Util.eqRexp(x,y) then T.TRUE else e
70 :     | ccexp reduce (e as T.CMP(_,T.NE,x,y)) =
71 :     if RTL.Util.eqRexp(x,y) then T.FALSE else e
72 :     | ccexp reduce e = e
73 :    
74 :     val rewriter =
75 :     RTL.Rewrite.rewrite{rexp=rexp, fexp=fexp, ccexp=ccexp, stm=stm}
76 :     in #stm rewriter rtl
77 :     end
78 :    
79 :     (*========================================================================
80 :     *
81 :     * Translate an RTL into something else
82 :     *
83 :     *========================================================================*)
84 :     fun transRTL
85 : leunga 775 {app,id,int,intinf,word32,string,list,Nil,tuple,record,arg,
86 : leunga 744 cellkind,oper,region}
87 :     rtl =
88 :     let fun word w = word32(Word.toLargeWord w)
89 :     fun binOp n (ty,x,y) = app(n,[int ty,rexp x,rexp y])
90 :     and unaryOp n (ty,x) = app(n,[int ty,rexp x])
91 : leunga 775 and rexp(T.LI i) = app("LI",[intinf i])
92 : leunga 744 | rexp(T.NEG x) = unaryOp "NEG" x
93 :     | rexp(T.ADD x) = binOp "ADD" x
94 :     | rexp(T.SUB x) = binOp "SUB" x
95 :     | rexp(T.MULS x) = binOp "MULS" x
96 :     | rexp(T.DIVS x) = binOp "DIVS" x
97 :     | rexp(T.REMS x) = binOp "REMS" x
98 :     | rexp(T.QUOTS x) = binOp "QUOTS" x
99 :     | rexp(T.MULU x) = binOp "MULU" x
100 :     | rexp(T.DIVU x) = binOp "DIVU" x
101 :     | rexp(T.REMU x) = binOp "REMU" x
102 :     | rexp(T.NEGT x) = unaryOp "NEGT" x
103 :     | rexp(T.ADDT x) = binOp "ADDT" x
104 :     | rexp(T.SUBT x) = binOp "SUBT" x
105 :     | rexp(T.MULT x) = binOp "MULT" x
106 :     | rexp(T.DIVT x) = binOp "DIVT" x
107 :     | rexp(T.REMT x) = binOp "REMT" x
108 :     | rexp(T.NOTB x) = unaryOp "NOTB" x
109 :     | rexp(T.ANDB x) = binOp "ANDB" x
110 :     | rexp(T.ORB x) = binOp "ORB" x
111 :     | rexp(T.XORB x) = binOp "XORB" x
112 :     | rexp(T.EQVB x) = binOp "EQVB" x
113 :     | rexp(T.SLL x) = binOp "SLL" x
114 :     | rexp(T.SRL x) = binOp "SRL" x
115 :     | rexp(T.SRA x) = binOp "SRA" x
116 :     | rexp(T.SX(t1,t2,x)) = app("SX",[int t1,int t2,rexp x])
117 :     | rexp(T.ZX(t1,t2,x)) = app("ZX",[int t1,int t2,rexp x])
118 :     | rexp(T.CVTF2I(t1,r,t2,x)) =
119 :     app("CVTF2I",[int t1,id(T.Basis.roundingModeToString r),
120 :     int t2,fexp x])
121 :     | rexp(T.COND(ty,cc,a,b)) =
122 :     app("COND",[int ty,ccexp cc,rexp a,rexp b])
123 :     | rexp(T.$(ty,k,e)) = app("$",[int ty,cellkind k,rexp e])
124 :     | rexp(T.ARG(ty,a,b)) = arg(ty,a,b)
125 :     | rexp(T.PARAM(i)) = app("PARAM",[int i])
126 :     | rexp(T.???) = id "???"
127 :     | rexp(T.OP(ty,opc,es)) =
128 :     app("OP",[int ty,oper opc,list(map rexp es, NONE)])
129 :     | rexp(T.BITSLICE(ty,sl,e)) =
130 :     app("BITSLICE",[int ty,slice sl,rexp e])
131 :     | rexp e = error("transRTL: "^RTL.Util.rexpToString e)
132 :     and slice sl = list(map (fn (x,y) => tuple[int x,int y]) sl, NONE)
133 :     and fbinOp n (ty,x,y) = app(n,[int ty,fexp x,fexp y])
134 :     and funaryOp n (ty,x) = app(n,[int ty,fexp x])
135 :     and fexp(T.FADD x) = fbinOp "FADD" x
136 :     | fexp(T.FSUB x) = fbinOp "FSUB" x
137 :     | fexp(T.FMUL x) = fbinOp "FMUL" x
138 :     | fexp(T.FDIV x) = fbinOp "FDIV" x
139 :     | fexp(T.FCOPYSIGN x) = fbinOp "FCOPYSIGN" x
140 :     | fexp(T.FNEG x) = funaryOp "FNEG" x
141 :     | fexp(T.FABS x) = funaryOp "FABS" x
142 :     | fexp(T.FSQRT x) = funaryOp "FSQRT" x
143 :     | fexp(T.FCOND(ty,cc,x,y)) =
144 :     app("FCOND",[int ty,ccexp cc,fexp x,fexp y])
145 :     | fexp(T.CVTI2F(t1,t2,x)) = app("CVTI2F",[int t1,int t2,rexp x])
146 :     | fexp(T.CVTF2F(t1,t2,x)) = app("CVTF2F",[int t1,int t2,fexp x])
147 :     | fexp e = error("transRTL: "^RTL.Util.fexpToString e)
148 :    
149 :     and stm(T.ASSIGN(ty,x,y)) = app("ASSIGN",[int ty,rexp x,rexp y])
150 :     | stm(T.JMP(e,_)) = app("JMP",[rexp e,Nil])
151 :     | stm(T.RET _) = app("RET",[Nil])
152 :     | stm(T.IF(x,y,z)) = app("IF",[ccexp x,stm y,stm z])
153 :     | stm(T.SEQ ss) = app("SEQ",[list(map stm ss,NONE)])
154 :     | stm(T.RTL{e, ...}) = stm e
155 :     | stm(T.CALL{funct,...}) = app("CALL",
156 :     [record[("defs",Nil),
157 :     ("uses",Nil),
158 :     ("funct",rexp funct),
159 :     ("targets",Nil),
160 :     ("region",region)]
161 :     ]
162 :     )
163 :     | stm s = error("transRTL: "^RTL.Util.stmToString s)
164 :    
165 :     and ccexp(T.CMP(ty,cc,x,y)) =
166 :     app("CMP",[int ty,id(T.Basis.condToString cc),rexp x,rexp y])
167 :     | ccexp(T.FCMP(ty,cc,x,y)) =
168 :     app("FCMP",[int ty,id(T.Basis.fcondToString cc),fexp x,fexp y])
169 :     | ccexp(T.TRUE) = id "TRUE"
170 :     | ccexp(T.FALSE) = id "FALSE"
171 :     | ccexp(T.AND(x,y)) = app("AND",[ccexp x,ccexp y])
172 :     | ccexp(T.OR(x,y)) = app("OR",[ccexp x,ccexp y])
173 :     | ccexp(T.XOR(x,y)) = app("XOR",[ccexp x,ccexp y])
174 :     | ccexp(T.EQV(x,y)) = app("EQV",[ccexp x,ccexp y])
175 :     | ccexp(T.NOT x) = app("NOT",[ccexp x])
176 :     | ccexp e = error("transRTL: "^RTL.Util.ccexpToString e)
177 :     in stm rtl
178 :     end
179 :    
180 :     (*========================================================================
181 :     * Translate an RTL to an expression
182 :     *========================================================================*)
183 :     fun rtlToExp rtl =
184 :     let fun id name = A.IDexp(A.IDENT(["T"],name))
185 :     fun app(n, es) = A.APPexp(id n, A.TUPLEexp es)
186 :     val int = U.INTexp
187 :     val string= U.STRINGexp
188 :     fun arg(ty,a,name) = A.IDexp(A.IDENT([],name))
189 :     fun cellkind k = A.IDexp(A.IDENT(["C"],CellsBasis.cellkindToString k))
190 :     fun oper(T.OPER{name,...}) = A.IDexp(A.IDENT(["P"],name))
191 :     val region=A.IDexp(A.IDENT(["T","Region"],"memory"))
192 :     in transRTL{id=id, app=app, list=A.LISTexp, string=string,
193 : leunga 775 int=int, intinf=U.INTINFexp,
194 :     word32=U.WORD32exp, Nil=A.LISTexp([],NONE),
195 : leunga 744 tuple=A.TUPLEexp, record=A.RECORDexp,
196 :     region=region, arg=arg, cellkind=cellkind, oper=oper
197 :     } rtl
198 :     end
199 :    
200 :     (*========================================================================
201 :     * Translate an RTL to a pattern
202 :     *========================================================================*)
203 :     fun rtlToPat rtl =
204 :     let fun mkId name = A.IDENT(["T"],name)
205 :     fun id name = A.CONSpat(mkId name,NONE)
206 :     fun app(n, [x]) = A.CONSpat(mkId n, SOME x)
207 :     | app(n, es) = A.CONSpat(mkId n, SOME(A.TUPLEpat es))
208 :     fun record ps = A.RECORDpat(ps,false)
209 :     val int = U.INTpat
210 : leunga 775 val intinf= U.INTINFpat
211 : leunga 744 val string= U.STRINGpat
212 :     fun arg(ty,a,name) = A.IDpat name
213 :     fun cellkind k = A.IDpat(CellsBasis.cellkindToString k)
214 :     fun oper(T.OPER{name,...}) =
215 :     A.CONSpat(A.IDENT(["T"],"OPER"),
216 :     SOME(A.RECORDpat([("name",U.STRINGpat name)],true)))
217 :     val region=A.WILDpat
218 :     in transRTL{id=id, app=app, list=A.LISTpat, string=string,
219 : leunga 775 int=int, intinf=intinf,
220 :     word32=U.WORD32pat, Nil=A.LISTpat([],NONE),
221 : leunga 744 tuple=A.TUPLEpat, record=record, region=region,
222 :     arg=arg, cellkind=cellkind, oper=oper
223 :     } rtl
224 :     end
225 :    
226 :     (*========================================================================
227 :     * Translate an RTL to a function with arguments
228 :     *========================================================================*)
229 :     fun rtlToFun(rtlName, rtlArgs, rtl) =
230 :     let val body = rtlToExp rtl
231 :     val args = A.RECORDpat(map (fn id => (id,A.IDpat id)) rtlArgs,false)
232 :     in A.FUNdecl
233 :     [A.FUNbind(rtlName, [A.CLAUSE([args], NONE, body)])]
234 :     end
235 :    
236 :     (*========================================================================
237 :     * Create a new_op
238 :     *========================================================================*)
239 :     fun createNewOp{name, hash, attribs} =
240 :     A.VALdecl[
241 :     A.VALbind(A.IDpat name,
242 :     A.APPexp(A.IDexp(A.IDENT(["T"],"OPER")),
243 :     A.APPexp(A.IDexp(A.IDENT(["RTL"],"newOp")),
244 :     A.RECORDexp[("name",U.STRINGexp name),
245 :     ("attribs",U.WORDexp (!attribs))
246 :     ])))
247 :     ]
248 :    
249 :     end
250 :    

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