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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 593 - (view) (download)

1 : leunga 591 (*
2 :     * This takes a bunch of RTL and build a database that can be reused.
3 :     *)
4 :     structure BuildRTL : BUILD_RTL =
5 :     struct
6 :     structure RTL = MLTreeRTL
7 :     structure T = RTL.T
8 :    
9 :     type ty = int
10 :    
11 :     fun newOper name = ref{name=name,hash=0w0,attribs=0w0}
12 :    
13 :     fun wordConst ty w = T.LI32(w)
14 :     fun intConst ty i = wordConst ty (Word32.fromInt i)
15 :    
16 :     fun error msg = MLRiscErrorMsg.error("BuildRTL",msg)
17 :    
18 :     fun fetch ty loc = T.REXT(ty,RTL.FETCH loc)
19 :    
20 :     val wildCard = newOper "?"
21 :    
22 :     fun op:= ty (x,y) = T.EXT(RTL.ASSIGN(x,y))
23 :     val noregion = T.LI 0
24 :     fun $ (k,ty) addr = RTL.CELL(k,ty,addr,noregion)
25 :     fun $$ (k,ty) (addr,region) = RTL.CELL(k,ty,addr,region)
26 :    
27 :     fun aggb (t1,t2) cell = RTL.AGG(t2,RTL.BIG_ENDIAN,cell)
28 :     fun aggl (t1,t2) cell = RTL.AGG(t2,RTL.LITTLE_ENDIAN,cell)
29 :     fun idaggr t cell = RTL.AGG(t,RTL.LITTLE_ENDIAN,cell)
30 :     fun copy ty (dst,src) = T.COPY(ty,[],[])
31 :     val dummyTy = 32
32 :    
33 :     fun ! (t,x,y) = T.REXT(t,RTL.ARG(x,y))
34 :    
35 :     (* Integer operators *)
36 :     fun unary f ty x = f(ty,x)
37 :     fun binary f ty (x, y) = f(ty,x,y)
38 :    
39 :     fun operand ty opn = opn
40 :     fun label ty label = label
41 :     fun immed ty imm = imm
42 :    
43 :     datatype kind = GP | FP | CC
44 :    
45 :     fun newOp name =
46 :     let val oper = newOper name
47 :     in fn xs => T.REXT(32,RTL.OP(oper,xs)) : RTL.exp
48 :     end
49 :    
50 :     val newCond = newOp
51 :    
52 :     fun sx (t1,t2) e = T.CVTI2I(t2,T.SIGN_EXTEND,t1,e)
53 :     fun zx (t1,t2) e = T.CVTI2I(t2,T.ZERO_EXTEND,t1,e)
54 :     fun ? ty = T.REXT(ty,RTL.OP(wildCard,[]))
55 :     fun forall t e = T.REXT(t,RTL.FORALL e)
56 :    
57 :     fun bitslice t2 ranges e =
58 :     let val t1 = foldr (fn ((a,b),l) => b-a+1+l) 0 ranges
59 :     val r = map (fn (a,b) => {from=T.LI a,to=T.LI b}) ranges
60 :     in T.REXT(t1,RTL.SLICE(r,t2,e)) end
61 :    
62 :     val not = T.NOT
63 :     val False = T.FALSE
64 :     val True = T.TRUE
65 :    
66 :     val op + = binary T.ADD
67 :     val op - = binary T.SUB
68 :     val muls = binary T.MULS
69 :     val mulu = binary T.MULU
70 :     val divs = binary T.DIVS
71 :     val divu = binary T.DIVU
72 :     val rems = binary T.REMS
73 :     val remu = binary T.REMU
74 :     fun ~ ty x = (op - ty) (intConst ty 0,x)
75 :    
76 :     val andb = binary T.ANDB
77 :     val orb = binary T.ORB
78 :     val xorb = binary T.XORB
79 :     val notb = unary T.NOTB
80 :     val << = binary T.SLL
81 :     val >> = binary T.SRL
82 :     val ~>> = binary T.SRA
83 :     fun eqvb ty (x,y) = notb ty (xorb ty (x,y))
84 :    
85 :     (* Trapping operators *)
86 :     val addt = binary T.ADDT
87 :     val subt = binary T.SUBT
88 :     val mult = binary T.MULT
89 :     val divt = binary T.DIVT
90 :     val remt = binary T.REMT
91 :    
92 :     fun cond ty (x,y,z) = T.COND(ty, x, y, z)
93 :    
94 :     (* Integer comparisons *)
95 :     fun cmp cond ty (x,y) = T.CMP(ty,cond,x,y)
96 :    
97 :     val == = cmp T.EQ
98 :     val op <> = cmp T.NE
99 :     val op > = cmp T.GT
100 :     val op < = cmp T.LT
101 :     val op <= = cmp T.LE
102 :     val op >= = cmp T.GT
103 :     val ltu = cmp T.LTU
104 :     val leu = cmp T.LEU
105 :     val gtu = cmp T.GTU
106 :     val geu = cmp T.GEU
107 :    
108 :     (* Floating point operators *)
109 :     fun funary f =
110 :     let val oper = newOper f
111 :     in fn ty => fn x => T.REXT(ty,RTL.OP(oper,[x]))
112 :     end
113 :     fun fbinary f =
114 :     let val oper = newOper f
115 :     in fn ty => fn (x,y) => T.REXT(ty,RTL.OP(oper,[x, y]))
116 :     end
117 :    
118 :     val fadd = fbinary "FADD"
119 :     val fsub = fbinary "FSUB"
120 :     val fmul = fbinary "FMUL"
121 :     val fdiv = fbinary "FDIV"
122 :     val fabs = funary "FABS"
123 :     val fneg = funary "FNEG"
124 :     val fsqrt = funary "FSQRT"
125 :    
126 :     (* Floating point comparisons *)
127 :     fun fcmp fcond =
128 :     let val name = T.Basis.fcondToString fcond
129 :     val oper = newOper name
130 :     in fn ty => fn (x,y) =>
131 :     T.CMP(ty,T.NE,T.REXT(ty,RTL.OP(oper,[x,y])),T.LI 0)
132 :     end
133 :    
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 |>=| = fcmp T.>=
153 :     val |?>=| = fcmp T.?>=
154 :     val |!<| = fcmp T.!<
155 :     val |!?=| = fcmp T.!?=
156 :     val |<>| = fcmp T.<>
157 :     val |!=| = fcmp T.!=
158 :     val |!?| = fcmp T.!?
159 :     val |<=>| = fcmp T.<=>
160 :     val |?<>| = fcmp T.?<>
161 :    
162 :     (* Action combinators *)
163 :     fun ||(a,b) = T.EXT(RTL.PAR(a,b))
164 :     val Nop = T.SEQ []
165 :     fun Jmp ty e = T.JMP([],e,[])
166 : leunga 593 fun Call ty e = T.CALL{funct=e,targets=[],defs=[],uses=[],
167 :     cdefs=[],cuses=[],region= ~1}
168 : leunga 591 val Ret = T.RET([],[])
169 :     fun If(x,y,z) = T.IF([],x,y,z)
170 :    
171 :     fun map ty = List.map
172 :     end

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