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/mltree/rtl-build.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/mltree/rtl-build.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 744 - (view) (download)

1 : leunga 744 (*
2 :     * Build MLTree-based RTLs
3 :     *)
4 :    
5 :     functor RTLBuild(RTL : MLTREE_RTL) : RTL_BUILD =
6 :     struct
7 :     structure RTL = RTL
8 :     structure T = RTL.T
9 :    
10 :     type effect = RTL.rtl
11 :     type exp = T.rexp
12 :     type ty = T.ty
13 :     type bool = T.ccexp
14 :     type region = T.rexp
15 :     type cond = T.cond
16 :     type fcond = T.fcond
17 :    
18 :     fun error msg = MLRiscErrorMsg.error("RTLBuild",msg)
19 :    
20 :     val hashCounter = ref 0w23
21 :     fun newHash() = !hashCounter before hashCounter := !hashCounter + 0w23499
22 :     fun newOper name = {name=name, hash=newHash(), attribs=ref 0w0}
23 :    
24 :     val newOpList = ref [] : T.Basis.misc_op list ref
25 :     fun getNewOps() = !newOpList
26 :     fun clearNewOps() = newOpList := []
27 :    
28 :     fun newOp name =
29 :     let val oper = newOper name
30 :     val _ = newOpList := oper :: !newOpList;
31 :     val oper = T.OPER oper
32 :     in fn es => T.OP(32, oper, es) (* XXX *)
33 :     end
34 :    
35 :     fun op:= ty (lhs,rhs) = T.ASSIGN(ty,lhs,rhs)
36 :    
37 :     fun $ (k,ty) e = T.$(ty,k,e)
38 :    
39 :     fun Mem (k,ty) (addr,mem) = T.$(ty,k,addr)
40 :    
41 :     fun ??? ty = T.???
42 :     fun Arg (ty,kind,name) = T.ARG(ty,ref(T.REP kind),name)
43 :     fun BitSlice ty slice e = T.BITSLICE(ty,slice,e)
44 :    
45 :     fun operand ty exp = exp
46 :     fun immed ty exp = exp
47 :     fun label ty exp = exp
48 :    
49 :     (* integer *)
50 :     fun intConst ty i = T.LI i
51 :     fun wordConst ty w = T.LI32 w
52 :    
53 :     fun binOp oper ty (x, y) = oper(ty,x,y)
54 :     fun unaryOp oper ty x = oper(ty,x)
55 :    
56 :     fun sx (from,to) e = T.SX(to, from, e)
57 :     fun zx (from,to) e = T.ZX(to, from, e)
58 :    
59 :     val op~ = unaryOp T.NEG
60 :     val op+ = binOp T.ADD
61 :     val op- = binOp T.SUB
62 :     val muls = binOp T.MULS
63 :     val divs = binOp T.DIVS
64 :     val quots = binOp T.QUOTS
65 :     val rems = binOp T.REMS
66 :     val mulu = binOp T.MULU
67 :     val divu = binOp T.DIVU
68 :     val remu = binOp T.REMU
69 :    
70 :     val negt = unaryOp T.NEGT
71 :     val addt = binOp T.ADDT
72 :     val subt = binOp T.SUBT
73 :     val mult = binOp T.MULT
74 :     val divt = binOp T.DIVT
75 :     val quott = binOp T.QUOTT
76 :     val remt = binOp T.REMT
77 :    
78 :     val notb = unaryOp T.NOTB
79 :     val andb = binOp T.ANDB
80 :     val orb = binOp T.ORB
81 :     val xorb = binOp T.XORB
82 :     val eqvb = binOp T.EQVB
83 :     val ~>> = binOp T.SRA
84 :     val >> = binOp T.SRL
85 :     val << = binOp T.SLL
86 :    
87 :     val True = T.TRUE
88 :     val False = T.FALSE
89 :     val Not = T.NOT
90 :     val And = T.AND
91 :     val Or = T.OR
92 :     val Xor = T.XOR
93 :     fun cmp cc ty (x,y) = T.CMP(ty,cc,x,y)
94 :     fun Cond ty (cond,x,y) = T.COND(ty,cond,x,y)
95 :    
96 :     val op== = cmp T.EQ
97 :     val op<> = cmp T.NE
98 :     val op>= = cmp T.GE
99 :     val op> = cmp T.GT
100 :     val op<= = cmp T.LE
101 :     val op< = cmp T.LT
102 :     val geu = cmp T.GEU
103 :     val gtu = cmp T.GTU
104 :     val leu = cmp T.LEU
105 :     val ltu = cmp T.LTU
106 :     val setcc = cmp T.SETCC
107 :     fun getcc ty (e,cc) = T.CMP(ty,cc,e,T.???)
108 :     (* floating point *)
109 :     fun i2f(ty,x) = T.CVTI2F(ty,ty,x)
110 :     fun f2i(ty,x) = T.CVTF2I(ty,T.TO_ZERO,ty,x)
111 :     fun fbinOp oper ty (x,y) = f2i(ty,oper(ty,i2f(ty,x),i2f(ty,y)))
112 :     fun funaryOp oper ty (x) = f2i(ty,oper(ty,i2f(ty,x)))
113 :     fun fcmp fcc ty (x,y) = T.FCMP(ty,fcc,i2f(ty,x),i2f(ty, y))
114 :     fun getfcc ty (e,cc) = T.FCMP(ty,cc,i2f(ty,e),i2f(ty,T.???))
115 :    
116 :     val fadd = fbinOp T.FADD
117 :     val fsub = fbinOp T.FSUB
118 :     val fmul = fbinOp T.FMUL
119 :     val fdiv = fbinOp T.FDIV
120 :     val fcopysign = fbinOp T.FCOPYSIGN
121 :     val fneg = funaryOp T.FNEG
122 :     val fabs = funaryOp T.FABS
123 :     val fsqrt = funaryOp T.FSQRT
124 :    
125 :     val |?| = fcmp T.?
126 :     val |!<=>| = fcmp T.!<=>
127 :     val |==| = fcmp T.==
128 :     val |?=| = fcmp T.?=
129 :     val |!<>| = fcmp T.!<>
130 :     val |!?>=| = fcmp T.!?>=
131 :     val |<| = fcmp T.<
132 :     val |?<| = fcmp T.?<
133 :     val |!>=| = fcmp T.!>=
134 :     val |!?>| = fcmp T.!?>
135 :     val |<=| = fcmp T.<=
136 :     val |?<=| = fcmp T.?<=
137 :     val |!>| = fcmp T.!>
138 :     val |!?<=| = fcmp T.!?<=
139 :     val |>| = fcmp T.>
140 :     val |?>| = fcmp T.?>
141 :     val |!<=| = fcmp T.!<=
142 :     val |!?<| = fcmp T.!?<
143 :     val |>=| = fcmp T.>=
144 :     val |?>=| = fcmp T.?>=
145 :     val |!<| = fcmp T.!<
146 :     val |!?=| = fcmp T.!?=
147 :     val |<>| = fcmp T.<>
148 :     val |!=| = fcmp T.!=
149 :     val |!?| = fcmp T.!?
150 :     val |<=>| = fcmp T.<=>
151 :     val |?<>| = fcmp T.?<>
152 :     val setfcc = fcmp T.SETFCC
153 :    
154 :     (* effects *)
155 :     val Nop = T.SEQ []
156 :     fun Jmp ty addr = T.JMP(addr,[])
157 :     fun Call ty addr = T.CALL{funct=addr, targets=[],
158 :     defs=[], uses=[],
159 :     region=T.Region.memory}
160 :     val Ret = T.RET([])
161 :    
162 :     fun If(T.TRUE, yes, no) = yes
163 :     | If(T.FALSE, yes, no) = no
164 :     | If(T.CMP(ty,cc,x,y),T.SEQ [],no) =
165 :     T.IF(T.CMP(ty,T.Basis.negateCond cc,x,y), no, Nop)
166 :     | If(a,b,c) = T.IF(a,b,c)
167 :    
168 :     fun Par(T.SEQ[],y) = y
169 :     | Par(x,T.SEQ[]) = x
170 :     | Par(T.SEQ xs,T.SEQ ys) = T.SEQ(xs@ys)
171 :     | Par(T.SEQ xs,y) = T.SEQ(xs@[y])
172 :     | Par(x,T.SEQ ys) = T.SEQ(x::ys)
173 :     | Par(x,y) = T.SEQ[x,y]
174 :    
175 :     val map = fn _ => List.map
176 :    
177 :     end

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