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 1202 - (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 : leunga 775 structure I = T.I
10 : leunga 744
11 :     type effect = RTL.rtl
12 :     type exp = T.rexp
13 :     type ty = T.ty
14 :     type bool = T.ccexp
15 :     type region = T.rexp
16 :     type cond = T.cond
17 :     type fcond = T.fcond
18 : george 1202 type div_rounding_mode = T.div_rounding_mode
19 : leunga 744
20 :     fun error msg = MLRiscErrorMsg.error("RTLBuild",msg)
21 :    
22 :     val hashCounter = ref 0w23
23 :     fun newHash() = !hashCounter before hashCounter := !hashCounter + 0w23499
24 :     fun newOper name = {name=name, hash=newHash(), attribs=ref 0w0}
25 :    
26 :     val newOpList = ref [] : T.Basis.misc_op list ref
27 :     fun getNewOps() = !newOpList
28 :     fun clearNewOps() = newOpList := []
29 :    
30 :     fun newOp name =
31 :     let val oper = newOper name
32 :     val _ = newOpList := oper :: !newOpList;
33 :     val oper = T.OPER oper
34 :     in fn es => T.OP(32, oper, es) (* XXX *)
35 :     end
36 :    
37 :     fun op:= ty (lhs,rhs) = T.ASSIGN(ty,lhs,rhs)
38 :    
39 :     fun $ (k,ty) e = T.$(ty,k,e)
40 :    
41 :     fun Mem (k,ty) (addr,mem) = T.$(ty,k,addr)
42 :    
43 :     fun ??? ty = T.???
44 :     fun Arg (ty,kind,name) = T.ARG(ty,ref(T.REP kind),name)
45 :     fun BitSlice ty slice e = T.BITSLICE(ty,slice,e)
46 :    
47 :     fun operand ty exp = exp
48 :     fun immed ty exp = exp
49 :     fun label ty exp = exp
50 :    
51 :     (* integer *)
52 : leunga 775 fun intConst ty i = T.LI(I.fromInt(ty, i))
53 :     fun wordConst ty w = T.LI(I.fromWord32(ty, w))
54 : leunga 744
55 : george 1202 fun ternaryOp oper ty (x, y, z) = oper(x, ty, y, z)
56 : leunga 744 fun binOp oper ty (x, y) = oper(ty,x,y)
57 :     fun unaryOp oper ty x = oper(ty,x)
58 :    
59 :     fun sx (from,to) e = T.SX(to, from, e)
60 :     fun zx (from,to) e = T.ZX(to, from, e)
61 :    
62 :     val op~ = unaryOp T.NEG
63 :     val op+ = binOp T.ADD
64 :     val op- = binOp T.SUB
65 :     val muls = binOp T.MULS
66 : george 1202 val divs = ternaryOp T.DIVS
67 :     val rems = ternaryOp T.REMS
68 : leunga 744 val mulu = binOp T.MULU
69 :     val divu = binOp T.DIVU
70 :     val remu = binOp T.REMU
71 :    
72 :     val negt = unaryOp T.NEGT
73 :     val addt = binOp T.ADDT
74 :     val subt = binOp T.SUBT
75 :     val mult = binOp T.MULT
76 : george 1202 val divt = ternaryOp T.DIVT
77 : leunga 744
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 setfcc = fcmp T.SETFCC
140 :    
141 :     (* effects *)
142 :     val Nop = T.SEQ []
143 :     fun Jmp ty addr = T.JMP(addr,[])
144 :     fun Call ty addr = T.CALL{funct=addr, targets=[],
145 :     defs=[], uses=[],
146 : blume 839 region=T.Region.memory,
147 :     pops=0}
148 : leunga 744 val Ret = T.RET([])
149 :    
150 :     fun If(T.TRUE, yes, no) = yes
151 :     | If(T.FALSE, yes, no) = no
152 :     | If(T.CMP(ty,cc,x,y),T.SEQ [],no) =
153 :     T.IF(T.CMP(ty,T.Basis.negateCond cc,x,y), no, Nop)
154 :     | If(a,b,c) = T.IF(a,b,c)
155 :    
156 :     fun Par(T.SEQ[],y) = y
157 :     | Par(x,T.SEQ[]) = x
158 :     | Par(T.SEQ xs,T.SEQ ys) = T.SEQ(xs@ys)
159 :     | Par(T.SEQ xs,y) = T.SEQ(xs@[y])
160 :     | Par(x,T.SEQ ys) = T.SEQ(x::ys)
161 :     | Par(x,y) = T.SEQ[x,y]
162 :    
163 :     val map = fn _ => List.map
164 :    
165 :     end

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