File: build-rtl.sml

package info (click to toggle)
mlton 20210117%2Bdfsg-3
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 58,464 kB
  • sloc: ansic: 27,682; sh: 4,455; asm: 3,569; lisp: 2,879; makefile: 2,347; perl: 1,169; python: 191; pascal: 68; javascript: 7
file content (173 lines) | stat: -rw-r--r-- 4,670 bytes parent folder | download | duplicates (5)
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
(*
 * This takes a bunch of RTL and build a database that can be reused.
 *)
structure BuildRTL : BUILD_RTL =
struct
   structure RTL = MLTreeRTL
   structure T   = RTL.T

   type ty = int

   fun newOper name = ref{name=name,hash=0w0,attribs=0w0}

   fun wordConst ty w = T.LI32(w)
   fun intConst ty i = wordConst ty (Word32.fromInt i)

   fun error msg = MLRiscErrorMsg.error("BuildRTL",msg)

   fun fetch ty loc = T.REXT(ty,RTL.FETCH loc)

   val wildCard = newOper "?"

   fun op:= ty (x,y) = T.EXT(RTL.ASSIGN(x,y))
   val noregion = T.LI 0
   fun $ (k,ty) addr = RTL.CELL(k,ty,addr,noregion)
   fun $$ (k,ty) (addr,region) = RTL.CELL(k,ty,addr,region)

   fun aggb (t1,t2) cell = RTL.AGG(t2,RTL.BIG_ENDIAN,cell)
   fun aggl (t1,t2) cell = RTL.AGG(t2,RTL.LITTLE_ENDIAN,cell)
   fun idaggr t cell     = RTL.AGG(t,RTL.LITTLE_ENDIAN,cell)
   fun copy ty (dst,src) = T.COPY(ty,[],[])
   val dummyTy = 32

   fun ! (t,x,y) =  T.REXT(t,RTL.ARG(x,y))

   (* Integer operators *)
   fun unary f ty x = f(ty,x) 
   fun binary f ty (x, y) = f(ty,x,y)
   fun ternary f ty (x, y, z) = f(ty, x, y, z)

   fun operand ty opn = opn 
   fun label ty label = label
   fun immed ty imm   = imm

   datatype kind = GP | FP | CC

   fun newOp name = 
   let val oper = newOper name 
   in  fn xs => T.REXT(32,RTL.OP(oper,xs)) : RTL.exp 
   end

   val newCond = newOp

   fun sx (t1,t2) e = T.CVTI2I(t2,T.SIGN_EXTEND,t1,e)
   fun zx (t1,t2) e = T.CVTI2I(t2,T.ZERO_EXTEND,t1,e)
   fun ? ty = T.REXT(ty,RTL.OP(wildCard,[]))
   fun forall t e = T.REXT(t,RTL.FORALL e)

   fun bitslice t2 ranges e =
       let val t1 = foldr (fn ((a,b),l) => b-a+1+l) 0 ranges
           val r =  map (fn (a,b) => {from=T.LI a,to=T.LI b}) ranges
       in  T.REXT(t1,RTL.SLICE(r,t2,e)) end

   val not   = T.NOT
   val False = T.FALSE
   val True  = T.TRUE

   val op +  = binary T.ADD
   val op -  = binary T.SUB
   val muls  = binary T.MULS
   val mulu  = binary T.MULU
   val divs  = ternary T.DIVS
   val divu  = binary T.DIVU
   val rems  = ternary T.REMS
   val remu  = binary T.REMU
   fun ~ ty x = (op - ty) (intConst ty 0,x)

   val andb  = binary T.ANDB
   val orb   = binary T.ORB
   val xorb  = binary T.XORB
   val notb  = unary  T.NOTB
   val <<    = binary T.SLL
   val >>    = binary T.SRL
   val ~>>   = binary T.SRA
   fun eqvb ty (x,y) = notb ty (xorb ty (x,y))

   (* Trapping operators *)
   val addt  = binary T.ADDT
   val subt  = binary T.SUBT
   val mult  = binary T.MULT
   val divt  = binary T.DIVT
   val remt  = binary T.REMT

   fun cond ty (x,y,z) = T.COND(ty, x, y, z)

   (* Integer comparisons *)
   fun cmp cond ty (x,y) = T.CMP(ty,cond,x,y) 

   val ==    = cmp T.EQ
   val op <> = cmp T.NE
   val op >  = cmp T.GT
   val op <  = cmp T.LT
   val op <= = cmp T.LE
   val op >= = cmp T.GE
   val ltu   = cmp T.LTU
   val leu   = cmp T.LEU
   val gtu   = cmp T.GTU
   val geu   = cmp T.GEU

   (* Floating point operators *)
   fun funary f =
   let val oper = newOper f 
   in  fn ty => fn x => T.REXT(ty,RTL.OP(oper,[x])) 
   end
   fun fbinary f =
   let val oper = newOper f 
   in  fn ty => fn (x,y) => T.REXT(ty,RTL.OP(oper,[x, y])) 
   end

   val fadd  = fbinary "FADD"
   val fsub  = fbinary "FSUB"
   val fmul  = fbinary "FMUL"
   val fdiv  = fbinary "FDIV"
   val fabs  = funary  "FABS"
   val fneg  = funary  "FNEG"
   val fsqrt = funary  "FSQRT"

   (* Floating point comparisons *)
   fun fcmp fcond =
   let val name = T.Basis.fcondToString fcond
       val oper = newOper name    
   in  fn ty => fn (x,y) =>
          T.CMP(ty,T.NE,T.REXT(ty,RTL.OP(oper,[x,y])),T.LI 0) 
   end

   val |?|     = fcmp T.?
   val |!<=>|  = fcmp T.!<=>
   val |==|    = fcmp T.==
   val |?=|    = fcmp T.?=
   val |!<>|   = fcmp T.!<>
   val |!?>=|  = fcmp T.!?>=
   val |<|     = fcmp T.<
   val |?<|    = fcmp T.?<
   val |!>=|   = fcmp T.!>=
   val |!?>|   = fcmp T.!?>
   val |<=|    = fcmp T.<=
   val |?<=|   = fcmp T.?<=
   val |!>|    = fcmp T.!>
   val |!?<=|  = fcmp T.!?<=
   val |>|     = fcmp T.>
   val |?>|    = fcmp T.?>
   val |!<=|   = fcmp T.!<=
   val |!?<|   = fcmp T.!?<
   val |>=|    = fcmp T.>=
   val |?>=|   = fcmp T.?>=
   val |!<|    = fcmp T.!<
   val |!?=|   = fcmp T.!?=
   val |<>|    = fcmp T.<>
   val |!=|    = fcmp T.!=
   val |!?|    = fcmp T.!?
   val |<=>|   = fcmp T.<=>
   val |?<>|   = fcmp T.?<>

   (* Action combinators *)
   fun ||(a,b) = T.EXT(RTL.PAR(a,b))
   val Nop   = T.SEQ []
   fun Jmp  ty e = T.JMP([],e,[])
   fun Call ty e = T.CALL{funct=e,targets=[],defs=[],uses=[],
                          cdefs=[],cuses=[],region= ~1}
   val Ret   = T.RET([],[])
   fun If(x,y,z) = T.IF([],x,y,z)

   fun map ty = List.map
end