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

# The following functions need to be defined elsewhere:
mb0's avatar
Up.  
mb0 committed
4
#   - arch-show-id
mb0's avatar
Up.  
mb0 committed
5

Julian Kranz's avatar
Julian Kranz committed
6
export = rreil-pretty
mb0's avatar
Up.  
mb0 committed
7

mb0's avatar
Up.  
mb0 committed
8
val rreil-pretty-stmt s = rreil-show-stmt s
mb0's avatar
Up.  
mb0 committed
9
val rreil-pretty ss = rreil-show-stmts ss
mb0's avatar
Up.  
mb0 committed
10
val rreil-pretty-rev ss = rreil-show-stmts (rreil-stmts-rev ss)
mb0's avatar
Up.  
mb0 committed
11

mb0's avatar
Up.  
mb0 committed
12
val rreil-show-stmts ss =
mb0's avatar
Up.  
mb0 committed
13 14
   case ss of  
      SEM_NIL: ""
mb0's avatar
Up.  
mb0 committed
15
    | SEM_CONS x: rreil-show-stmt x.hd +++ "\n" +++ rreil-show-stmts x.tl
mb0's avatar
Up.  
mb0 committed
16 17
   end

Julian Kranz's avatar
Julian Kranz committed
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
val rreil-show-varl v = rreil-show-var v +++ ":" +++ show-int v.size

val rreil-show-varls vs = let
  val show-inner vs =
    case vs of
       SEM_VARLS_CONS c: ", " +++ rreil-show-varl c.hd +++ show-inner c.tl
     | SEM_VARLS_NIL: ""
    end
in
  case vs of
     SEM_VARLS_CONS c: case c.tl of
          SEM_VARLS_CONS d: "(" +++ rreil-show-varl c.hd +++ show-inner c.tl +++ ")"
        | SEM_VARLS_NIL: rreil-show-varl c.hd
       end
     | SEM_VARLS_NIL: "(void)"
  end
end

val rreil-show-flop f =
  case f of
     SEM_FADD: "FADD"
   | SEM_FSUB: "FSUB"
   | SEM_FMUL: "FMUL"
  end

mb0's avatar
Up.  
mb0 committed
43
val rreil-show-stmt s =
Julian Kranz's avatar
Julian Kranz committed
44
  case s of
45 46 47
     SEM_ASSIGN x: rreil-show-var x.lhs +++ " =:" +++ show-int x.size +++ " " +++ rreil-show-expr x.rhs 
   | SEM_LOAD x: rreil-show-var x.lhs +++ " =:" +++ show-int x.size +++ " " +++ rreil-show-ptrderef x.size x.address
   | SEM_STORE x: "*" +++ rreil-show-address x.address +++ " =:" +++ show-int x.size +++ " " +++ rreil-show-expr x.rhs
Julian Kranz's avatar
Julian Kranz committed
48 49 50 51
   | SEM_ITE x: "if (" +++ rreil-show-sexpr x.cond +++ ") {\n" +++ rreil-show-stmts x.then_branch +++ "} else {\n" +++ rreil-show-stmts x.else_branch +++ "}"
   | SEM_WHILE x: "while (" +++ rreil-show-sexpr x.cond +++ ") {\n" +++ rreil-show-stmts x.body +++ "}"
   | SEM_CBRANCH x: "if (" +++ rreil-show-sexpr x.cond +++ ") goto " +++ rreil-show-address x.target-true +++ " else goto " +++ rreil-show-address x.target-false
   | SEM_BRANCH x: "goto [" +++ rreil-show-hint x.hint +++ "] " +++ rreil-show-address x.target
Julian Kranz's avatar
Julian Kranz committed
52 53
   | SEM_PRIM p: rreil-show-varls p.lhs +++ " = $" +++ from-string-lit p.op +++ " " +++ rreil-show-varls p.rhs
   | SEM_FLOP f: rreil-show-varl f.lhs +++ " = $" +++ rreil-show-flop f.op +++ " " +++ rreil-show-varls f.rhs +++ " [flags:" +++ rreil-show-var f.flags +++ "]"
Julian Kranz's avatar
Julian Kranz committed
54
  end
mb0's avatar
Up.  
mb0 committed
55

Julian Kranz's avatar
Julian Kranz committed
56 57 58 59 60 61 62
val rreil-show-hint x =
  case x of
     HINT_JUMP: "JUMP"
   | HINT_CALL: "CALL"
   | HINT_RET: "RET"
  end

Axel Simon's avatar
Axel Simon committed
63
val rreil-show-label l = "l" +++ show-int l +++ ":"
mb0's avatar
Up.  
mb0 committed
64

Julian Kranz's avatar
Julian Kranz committed
65 66 67 68 69 70 71 72 73 74
val rreil-show-op-cmp cmp =
  case cmp of
     SEM_CMPEQ x: "==" +++ rreil-show-cmp x
   | SEM_CMPNEQ x: "/=" +++ rreil-show-cmp x
   | SEM_CMPLES x: "<=s" +++ rreil-show-cmp x
   | SEM_CMPLEU x: "<=u" +++ rreil-show-cmp x
   | SEM_CMPLTS x: "<s" +++ rreil-show-cmp x
   | SEM_CMPLTU x: "<u" +++ rreil-show-cmp x
  end

Julian Kranz's avatar
Julian Kranz committed
75 76
val rreil-show-expr expr =
   case expr of
77
      SEM_SEXPR x: rreil-show-sexpr x
mb0's avatar
Up.  
mb0 committed
78 79 80 81 82 83 84 85 86 87
    | SEM_MUL x: "mul" +++ rreil-show-arity2 x
    | SEM_DIV x: "div" +++ rreil-show-arity2 x
    | SEM_DIVS x: "divs" +++ rreil-show-arity2 x
    | SEM_MOD x: "mod" +++ rreil-show-arity2 x
    | SEM_SHL x: "shl" +++ rreil-show-arity2 x
    | SEM_SHR x: "shr" +++ rreil-show-arity2 x
    | SEM_SHRS x: "shrs" +++ rreil-show-arity2 x
    | SEM_AND x: "and" +++ rreil-show-arity2 x
    | SEM_OR x: "or" +++ rreil-show-arity2 x
    | SEM_XOR x: "xor" +++ rreil-show-arity2 x
88 89
    | SEM_SX x: "sx[" +++ show-int x.fromsize +++ "->#](" +++ rreil-show-linear x.opnd1 +++ ")"
    | SEM_ZX x: "zx[" +++ show-int x.fromsize +++ "->#](" +++ rreil-show-linear x.opnd1 +++ ")"
mb0's avatar
Up.  
mb0 committed
90 91
   end

92 93 94
val rreil-show-arity1 x = " (" +++ rreil-show-linear x.opnd1 +++ ")"
val rreil-show-arity2 x = " (" +++ rreil-show-linear x.opnd1 +++ "," +++ rreil-show-linear x.opnd2 +++ ")"
val rreil-show-cmp x = " [*->1](" +++ rreil-show-linear x.opnd1 +++ "," +++ rreil-show-linear x.opnd2 +++ ")"
Axel Simon's avatar
Axel Simon committed
95 96
val rreil-show-ptrderef sz addr = "*[" +++ show-int addr.size +++ "->" +++ show-int sz +++ "](" +++ rreil-show-linear addr.address +++ ")"
val rreil-show-address addr = "[" +++ show-int addr.size +++ "](" +++ rreil-show-linear addr.address +++ ")"
mb0's avatar
Up.  
mb0 committed
97
val rreil-show-var x =
mb0's avatar
Up.  
mb0 committed
98
   case x.offset of
mb0's avatar
Up.  
mb0 committed
99
      0: rreil-show-id x.id
Axel Simon's avatar
Axel Simon committed
100
    | o: rreil-show-id x.id +++ "/" +++ show-int o
mb0's avatar
Up.  
mb0 committed
101 102
   end

mb0's avatar
Up.  
mb0 committed
103
val rreil-show-linear lin = 
mb0's avatar
Up.  
mb0 committed
104
   case lin of
mb0's avatar
Up.  
mb0 committed
105
      SEM_LIN_VAR x: rreil-show-var x
Axel Simon's avatar
Axel Simon committed
106
    | SEM_LIN_IMM x: show-int x.const
mb0's avatar
Up.  
mb0 committed
107 108
    | SEM_LIN_ADD x: rreil-show-linear x.opnd1 +++ "+" +++ rreil-show-linear x.opnd2
    | SEM_LIN_SUB x: rreil-show-linear x.opnd1 +++ "-" +++ rreil-show-linear x.opnd2
mb0's avatar
Up.  
mb0 committed
109
    | SEM_LIN_SCALE x:
110
         case x.const of
mb0's avatar
Up.  
mb0 committed
111
            0: ""
mb0's avatar
Up.  
mb0 committed
112
          | 1: rreil-show-linear x.opnd
Axel Simon's avatar
Axel Simon committed
113
          | s: show-int s +++ "*" +++ rreil-show-linear x.opnd
mb0's avatar
Up.  
mb0 committed
114 115 116
         end
   end

Julian Kranz's avatar
Julian Kranz committed
117 118 119 120
val rreil-show-sexpr sexpr =
  case sexpr of
	   SEM_SEXPR_LIN l: rreil-show-linear l
	 | SEM_SEXPR_CMP c: rreil-show-op-cmp c
121
   | SEM_SEXPR_ARB: "arbitrary"
Julian Kranz's avatar
Julian Kranz committed
122 123
	end

mb0's avatar
Up.  
mb0 committed
124
val rreil-show-id id =
mb0's avatar
Up.  
mb0 committed
125
   case id of
Julian Kranz's avatar
Julian Kranz committed
126 127
      FLOATING_FLAGS: "FLOATING_FLAGS"
    | VIRT_T x: "T" +++ show-int x
Axel Simon's avatar
Axel Simon committed
128
    | _: arch-show-id id
mb0's avatar
Up.  
mb0 committed
129
   end