rreil.ml 5.45 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
type sem_stmts =
mb0's avatar
Foo.  
mb0 committed
61
   SEM_CONS of {hd:sem_stmt, tl:sem_stmts}
mb0's avatar
mb0 committed
62 63
 | SEM_NIL

mb0's avatar
mb0 committed
64 65 66 67
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
68 69 70
val rreil-sizeOf op =
   case op of
      SEM_LIN x: x.size
Julian Kranz's avatar
Julian Kranz committed
71
    | SEM_BSWAP x: x.size
mb0's avatar
Up  
mb0 committed
72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
    | 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
93
val rreil-stmts-rev stmts =
mb0's avatar
mb0 committed
94 95 96 97
   let
      val lp stmt acc =
         case stmt of
            SEM_NIL: acc
mb0's avatar
Up.  
mb0 committed
98
          | SEM_CONS x: lp x.tl (SEM_CONS{hd=x.hd, tl=acc})
mb0's avatar
mb0 committed
99 100 101 102 103 104 105
         end
   in
      lp stmts SEM_NIL
   end

val var//0 x = {id=x,offset=0}
val var x = SEM_LIN_VAR x
mb0's avatar
sem.  
mb0 committed
106

mb0's avatar
mb0 committed
107
val mktemp = do
mb0's avatar
sem.  
mb0 committed
108
   t <- query $tmp;
mb0's avatar
Foo.  
mb0 committed
109
   t' <- return (t + 1);
mb0's avatar
sem.  
mb0 committed
110
   update @{tmp=t'};
mb0's avatar
Foo.  
mb0 committed
111
   return {id=VIRT_T t,offset=0}
mb0's avatar
sem.  
mb0 committed
112
end
mb0's avatar
mb0 committed
113

mb0's avatar
mb0 committed
114 115 116 117
val mklabel = do
   l <- query $lab;
   l' <- return (l + 1);
   update @{lab=l'};
mb0's avatar
Up.  
mb0 committed
118
   return l
mb0's avatar
mb0 committed
119 120
end

mb0's avatar
mb0 committed
121
val /ASSIGN a b = SEM_ASSIGN{lhs=a,rhs=b}
mb0's avatar
Foo.  
mb0 committed
122
val /LOAD sz a b = SEM_LOAD{lhs=a,size=sz,address=b}
mb0's avatar
mb0 committed
123
val /STORE a b = SEM_STORE{address=a,rhs=b}
mb0's avatar
Foo.  
mb0 committed
124
val /ADD a b = SEM_LIN_ADD{opnd1=a,opnd2=b}
mb0's avatar
mb0 committed
125
val /SUB a b = SEM_LIN_SUB{opnd1=a,opnd2=b}
mb0's avatar
Up.  
mb0 committed
126
val /LABEL l = SEM_LABEL{label=l}
mb0's avatar
mb0 committed
127
val /IFGOTOLABEL c l = SEM_IF_GOTO_LABEL{cond=c,label=l}
mb0's avatar
Up.  
mb0 committed
128
val /IFGOTO c sz t = SEM_IF_GOTO{cond=c,size=sz,target=t}
mb0's avatar
mb0 committed
129
val /GOTOLABEL l = SEM_IF_GOTO_LABEL{cond=SEM_LIN_IMM{imm=1},label=l}
mb0's avatar
mb0 committed
130 131

val push insn = do
mb0's avatar
Foo.  
mb0 committed
132 133
   tl <- query $stack;
   update @{stack=SEM_CONS{hd=insn,tl=tl}}
mb0's avatar
mb0 committed
134
end
mb0's avatar
mb0 committed
135

mb0's avatar
Foo.  
mb0 committed
136
val mov sz a b = push (/ASSIGN a (SEM_LIN{size=sz,opnd1=b}))
mb0's avatar
mb0 committed
137
val undef sz a = push (/ASSIGN a (SEM_ARB{size=sz}))
mb0's avatar
Foo.  
mb0 committed
138
val load sz a psz b = push (/LOAD sz a {size=psz,address=b})
mb0's avatar
mb0 committed
139
val store a b = push (/STORE a b)
mb0's avatar
Foo.  
mb0 committed
140
val add sz a b c = push (/ASSIGN a (SEM_LIN{size=sz,opnd1= /ADD b c}))
mb0's avatar
mb0 committed
141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163
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
164
val ifgoto c sz addr = push (/IFGOTO c sz addr)
mb0's avatar
mb0 committed
165

mb0's avatar
mb0 committed
166
val const i = return (SEM_LIN_IMM{imm=i})
mb0's avatar
mb0 committed
167

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