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
mb0's avatar
mb0 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 50 51 52

type sem_stmt = 
   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 60 61

type sem_stmts = 
   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 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92
val rreil-sizeOf op =
   case op of
      SEM_LIN x: x.size
    | SEM_BSWAP x: x.size 
    | 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