rreil.ml 6.58 KB
Newer Older
mb0's avatar
Up.    
mb0 committed
1
# vim:filetype=sml:ts=3:sw=3:expandtab
mb0's avatar
mb0 committed
2

mb0's avatar
Foo.    
mb0 committed
3
type sem_id =
mb0's avatar
Up.    
mb0 committed
4
   ARCH_R of int
mb0's avatar
mb0 committed
5
6
7
8
9
10
 | VIRT_EQ  # ==
 | VIRT_NEQ # /=
 | VIRT_LES # <=s
 | VIRT_LEU # <=u
 | VIRT_LTS # <s
 | VIRT_LTU # <u
mb0's avatar
Foo.    
mb0 committed
11
 | VIRT_T of int
mb0's avatar
mb0 committed
12

mb0's avatar
Foo.    
mb0 committed
13
14
type sem_arity1 = {size: int, opnd1: sem_linear}
type sem_arity2 = {size: int, opnd1: sem_linear, opnd2: sem_linear}
mb0's avatar
mb0 committed
15
type sem_cmp = {size: int, opnd1: sem_linear, opnd2: sem_linear}
mb0's avatar
mb0 committed
16

mb0's avatar
Foo.    
mb0 committed
17
18
type sem_address = {size: int, address: sem_linear}
type sem_var = {id:sem_id, offset:int}
mb0's avatar
mb0 committed
19

mb0's avatar
Foo.    
mb0 committed
20
21
22
type sem_linear =
   SEM_LIN_VAR of sem_var
 | SEM_LIN_IMM of {imm:int}
mb0's avatar
mb0 committed
23
24
 | SEM_LIN_ADD of {opnd1: sem_linear, opnd2: sem_linear}
 | SEM_LIN_SUB of {opnd1: sem_linear, opnd2: sem_linear}
mb0's avatar
Foo.    
mb0 committed
25
 | SEM_LIN_SCALE of {imm:int, opnd:sem_linear}
mb0's avatar
mb0 committed
26

mb0's avatar
Foo.    
mb0 committed
27
28
type sem_op =
   SEM_LIN of sem_arity1
Julian Kranz's avatar
Julian Kranz committed
29
 | SEM_BSWAP of sem_arity1
mb0's avatar
Foo.    
mb0 committed
30
 | SEM_MUL of sem_arity2
mb0's avatar
mb0 committed
31
 | SEM_DIV of sem_arity2
mb0's avatar
mb0 committed
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 | SEM_DIVS of sem_arity2
 | SEM_MOD of sem_arity2
 | SEM_SHL of sem_arity2
 | SEM_SHR of sem_arity2
 | SEM_SHRS of sem_arity2
 | SEM_AND of sem_arity2
 | SEM_OR of sem_arity2
 | SEM_XOR of sem_arity2
 | SEM_SX of {size: int, fromsize: int, opnd1: sem_linear}
 | SEM_ZX of {size: int, fromsize: int, opnd1: sem_linear}
 | SEM_CMPEQ of sem_cmp
 | SEM_CMPNEQ of sem_cmp
 | SEM_CMPLES of sem_cmp
 | SEM_CMPLEU of sem_cmp
 | SEM_CMPLTS of sem_cmp
 | SEM_CMPLTU of sem_cmp
 | SEM_ARB of {size: int}
mb0's avatar
Foo.    
mb0 committed
49

Julian Kranz's avatar
Julian Kranz committed
50
type sem_stmt =
mb0's avatar
Foo.    
mb0 committed
51
52
   SEM_ASSIGN of {lhs: sem_var, rhs: sem_op}
 | SEM_LOAD of {lhs: sem_var, size: int, address: sem_address}
mb0's avatar
mb0 committed
53
 | SEM_STORE of {address: sem_address, rhs: sem_op}
mb0's avatar
Up.    
mb0 committed
54
 | SEM_LABEL of {label: int}
mb0's avatar
mb0 committed
55
 | SEM_IF_GOTO_LABEL of {cond:sem_linear, label: int}
mb0's avatar
Up.    
mb0 committed
56
 | SEM_IF_GOTO of {cond: sem_linear, size:int, target: sem_linear}
mb0's avatar
Up.    
mb0 committed
57
58
 | SEM_CALL of {cond: sem_linear, size:int, target: sem_linear}
 | SEM_RETURN of {cond: sem_linear, size:int, target: sem_linear}
mb0's avatar
Foo.    
mb0 committed
59

Julian Kranz's avatar
Julian Kranz committed
60
61
62
63
64
65
66
67
68
69
 | SEM_ITE of {cond: sem_linear, then_branch: sem_stmts, else_branch: sem_stmts}
 | SEM_WHILE of {cond: sem_linear, body: sem_stmts}
 | SEM_CBRANCH of {cond: sem_linear, target_true: sem_address, target_false: sem_address}
 | SEM_BRANCH of {hint: branch_hint, target: sem_address}

 type branch_hint =
    HINT_JUMP
  | HINT_CALL
  | HINT_RET

Julian Kranz's avatar
Julian Kranz committed
70
type sem_stmts =
mb0's avatar
Foo.    
mb0 committed
71
   SEM_CONS of {hd:sem_stmt, tl:sem_stmts}
mb0's avatar
mb0 committed
72
73
 | SEM_NIL

mb0's avatar
mb0 committed
74
75
76
77
type sem_writeback =
   SEM_WRITE_VAR of {size: int, id: sem_var}
 | SEM_WRITE_MEM of {size: int, address: sem_linear}

mb0's avatar
Up    
mb0 committed
78
79
80
val rreil-sizeOf op =
   case op of
      SEM_LIN x: x.size
Julian Kranz's avatar
Julian Kranz committed
81
    | SEM_BSWAP x: x.size
mb0's avatar
Up    
mb0 committed
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
    | SEM_MUL x: x.size
    | SEM_DIV x: x.size
    | SEM_DIVS x: x.size
    | SEM_MOD x: x.size
    | SEM_SHL x: x.size
    | SEM_SHR x: x.size
    | SEM_SHRS x: x.size
    | SEM_AND x: x.size
    | SEM_OR x: x.size
    | SEM_XOR x: x.size
    | SEM_SX x: x.size
    | SEM_ZX x: x.size
    | SEM_CMPEQ x: 1
    | SEM_CMPNEQ x: 1
    | SEM_CMPLES x: 1
    | SEM_CMPLEU x: 1
    | SEM_CMPLTS x: 1
    | SEM_CMPLTU x: 1
    | SEM_ARB x: x.size
   end

mb0's avatar
Up.    
mb0 committed
103
val rreil-stmts-rev stmts =
mb0's avatar
mb0 committed
104
105
106
107
   let
      val lp stmt acc =
         case stmt of
            SEM_NIL: acc
mb0's avatar
Up.    
mb0 committed
108
          | SEM_CONS x: lp x.tl (SEM_CONS{hd=x.hd, tl=acc})
mb0's avatar
mb0 committed
109
110
111
112
113
114
         end
   in
      lp stmts SEM_NIL
   end

val var//0 x = {id=x,offset=0}
Julian Kranz's avatar
Julian Kranz committed
115
val at-offset x offset = {id=x.id,offset=offset}
mb0's avatar
mb0 committed
116
val var x = SEM_LIN_VAR x
Julian Kranz's avatar
Julian Kranz committed
117
val lin sz l = SEM_LIN {size=sz, opnd1=l}
Julian Kranz's avatar
Julian Kranz committed
118
val address sz addr = {size=sz, address=addr}
mb0's avatar
sem.    
mb0 committed
119

mb0's avatar
mb0 committed
120
val mktemp = do
mb0's avatar
sem.    
mb0 committed
121
   t <- query $tmp;
mb0's avatar
Foo.    
mb0 committed
122
   t' <- return (t + 1);
mb0's avatar
sem.    
mb0 committed
123
   update @{tmp=t'};
mb0's avatar
Foo.    
mb0 committed
124
   return {id=VIRT_T t,offset=0}
mb0's avatar
sem.    
mb0 committed
125
end
mb0's avatar
mb0 committed
126

mb0's avatar
mb0 committed
127
128
129
130
val mklabel = do
   l <- query $lab;
   l' <- return (l + 1);
   update @{lab=l'};
mb0's avatar
Up.    
mb0 committed
131
   return l
mb0's avatar
mb0 committed
132
133
end

mb0's avatar
mb0 committed
134
val /ASSIGN a b = SEM_ASSIGN{lhs=a,rhs=b}
mb0's avatar
Foo.    
mb0 committed
135
val /LOAD sz a b = SEM_LOAD{lhs=a,size=sz,address=b}
mb0's avatar
mb0 committed
136
val /STORE a b = SEM_STORE{address=a,rhs=b}
mb0's avatar
Foo.    
mb0 committed
137
val /ADD a b = SEM_LIN_ADD{opnd1=a,opnd2=b}
mb0's avatar
mb0 committed
138
val /SUB a b = SEM_LIN_SUB{opnd1=a,opnd2=b}
mb0's avatar
Up.    
mb0 committed
139
val /LABEL l = SEM_LABEL{label=l}
mb0's avatar
mb0 committed
140
val /IFGOTOLABEL c l = SEM_IF_GOTO_LABEL{cond=c,label=l}
mb0's avatar
Up.    
mb0 committed
141
val /IFGOTO c sz t = SEM_IF_GOTO{cond=c,size=sz,target=t}
mb0's avatar
mb0 committed
142
val /GOTOLABEL l = SEM_IF_GOTO_LABEL{cond=SEM_LIN_IMM{imm=1},label=l}
Julian Kranz's avatar
Julian Kranz committed
143
144
val /ITE c t e = SEM_ITE{cond=c,then_branch=t,else_branch=e}
val /WHILE c b = SEM_WHILE{cond=c,body=b}
Julian Kranz's avatar
Julian Kranz committed
145
val /CALL address = SEM_BRANCH{hint=HINT_CALL,target=address}
mb0's avatar
mb0 committed
146
147

val push insn = do
mb0's avatar
Foo.    
mb0 committed
148
149
   tl <- query $stack;
   update @{stack=SEM_CONS{hd=insn,tl=tl}}
mb0's avatar
mb0 committed
150
end
mb0's avatar
mb0 committed
151

Julian Kranz's avatar
Julian Kranz committed
152
153
154
val pop-all = do
  head <- query $stack;
  update @{stack=SEM_NIL};
Julian Kranz's avatar
Julian Kranz committed
155
  return head
Julian Kranz's avatar
Julian Kranz committed
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
end

#val connect-tail stmt tail =
#  case stmt of
#     SEM_NIL: tail
#   | SEM_CONS x: SEM_CONS{hd=x.hd,tl=(connect-tail x.tl tail)}
#  end

#val concat stmt = do
#  tail <- query $stack;
#  update @{stack=(connect-tail stmt tail)}
#end

val stack-set stmt = do
   update @{stack=stmt}
end

mb0's avatar
Foo.    
mb0 committed
173
val mov sz a b = push (/ASSIGN a (SEM_LIN{size=sz,opnd1=b}))
mb0's avatar
mb0 committed
174
val undef sz a = push (/ASSIGN a (SEM_ARB{size=sz}))
mb0's avatar
Foo.    
mb0 committed
175
val load sz a psz b = push (/LOAD sz a {size=psz,address=b})
mb0's avatar
mb0 committed
176
val store a b = push (/STORE a b)
mb0's avatar
Foo.    
mb0 committed
177
val add sz a b c = push (/ASSIGN a (SEM_LIN{size=sz,opnd1= /ADD b c}))
mb0's avatar
mb0 committed
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
val sub sz a b c = push (/ASSIGN a (SEM_LIN{size=sz,opnd1= /SUB b c}))
val andb sz a b c = push (/ASSIGN a (SEM_AND{size=sz,opnd1=b,opnd2=c}))
val orb sz a b c = push (/ASSIGN a (SEM_OR{size=sz,opnd1=b,opnd2=c}))
val xorb sz a b c = push (/ASSIGN a (SEM_XOR{size=sz,opnd1=b,opnd2=c}))
val mul sz a b c = push (/ASSIGN a (SEM_MUL{size=sz,opnd1=b,opnd2=c}))
val div sz a b c = push (/ASSIGN a (SEM_DIV{size=sz,opnd1=b,opnd2=c}))
val divs sz a b c = push (/ASSIGN a (SEM_DIVS{size=sz,opnd1=b,opnd2=c}))
val shl sz a b c = push (/ASSIGN a (SEM_SHL{size=sz,opnd1=b,opnd2=c}))
val shr sz a b c = push (/ASSIGN a (SEM_SHR{size=sz,opnd1=b,opnd2=c}))
val shrs sz a b c = push (/ASSIGN a (SEM_SHRS{size=sz,opnd1=b,opnd2=c}))
val bswap sz a b = push (/ASSIGN a (SEM_BSWAP{size=sz,opnd1=b}))
val movsx szA a szB b = push (/ASSIGN a (SEM_SX{size=szA,fromsize=szB,opnd1=b}))
val movzx szA a szB b = push (/ASSIGN a (SEM_ZX{size=szA,fromsize=szB,opnd1=b}))
val convert szA a szB b = push (/ASSIGN a (SEM_ZX{size=szA,fromsize=szB,opnd1=b}))
val cmpeq sz f a b = push (/ASSIGN f (SEM_CMPEQ{size=sz,opnd1=a,opnd2=b}))
val cmpneq sz f a b = push (/ASSIGN f (SEM_CMPNEQ{size=sz,opnd1=a,opnd2=b}))
val cmples sz f a b = push (/ASSIGN f (SEM_CMPLES{size=sz,opnd1=a,opnd2=b}))
val cmpleu sz f a b = push (/ASSIGN f (SEM_CMPLEU{size=sz,opnd1=a,opnd2=b}))
val cmplts sz f a b = push (/ASSIGN f (SEM_CMPLTS{size=sz,opnd1=a,opnd2=b}))
val cmpltu sz f a b = push (/ASSIGN f (SEM_CMPLTU{size=sz,opnd1=a,opnd2=b}))
val label l = push (/LABEL l)
val ifgotolabel c l = push (/IFGOTOLABEL c l)
val gotolabel l = push (/GOTOLABEL l)
mb0's avatar
Up.    
mb0 committed
201
val ifgoto c sz addr = push (/IFGOTO c sz addr)
Julian Kranz's avatar
Julian Kranz committed
202
203
val ite c t e = push (/ITE c t e)
val while c b = push (/WHILE c b)
Julian Kranz's avatar
Julian Kranz committed
204
val call address = push (/CALL address)
mb0's avatar
mb0 committed
205

mb0's avatar
mb0 committed
206
val const i = return (SEM_LIN_IMM{imm=i})
Julian Kranz's avatar
Julian Kranz committed
207
val imm i = SEM_LIN_IMM{imm=i}
mb0's avatar
mb0 committed
208

mb0's avatar
Up.    
mb0 committed
209
210
val /+ x offs = @{offset=offs} x
val /++ x offs = @{offset= $offset x + offs} x