Up.

detail/codegen/codegen-mangle.sml

@@ -69,9 +69,9 @@ structure Mangle = struct
              | #"=" => "_eq_"
              | #"!" => "_ex_"
              | #"*" => "_star_"
-             | #"-" => "_minus_"
+             | #"-" => "_"
              | #"+" => "_plus_"
-             | #"^" => "_concat_"
+             | #"^" => "_hat_"
              | #"/" => "_slash_"
              | #"?" => "_q_"
              | _ => String.str c

detail/semantic/inference.sml

@@ -131,7 +131,7 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
    (* define a second traversal that is a full inference of the tree *)
    
    (*local helper function to infer types for a binding group*)
-   val maxIter = 1
+   val maxIter = 2
    fun calcSubset printWarn env =
       let
          fun checkUsage sym (s, unstable) =
@@ -762,7 +762,7 @@ fun typeInferencePass (errStrm, ti : TI.type_info, ast) = let
                      ) toplevelEnv (ast : SpecAbstractTree.specification)
    val toplevelEnv = calcFixpoint toplevelEnv
                         handle TypeError => toplevelEnv
-   (*val _ = TextIO.print ("toplevel environment:\n" ^ E.toString toplevelEnv)*)
+   val _ = TextIO.print ("toplevel environment:\n" ^ E.toString toplevelEnv)
 
    (* check if all exported functions can be run with an empty state *)
    fun checkDecoder s sym = case E.forceNoInputs (sym,toplevelEnv) of

specifications/rreil/rreil-pretty.ml

 # vim:filetype=sml:ts=3:sw=3:expandtab
 
 # The following functions need to be defined elsewhere:
-#   - show/arch
+#   - arch-show-id
 
-export = prettyrreil
+export = rreil-pretty
 
-val prettyrreil ss = showrreil/stmts ss
+val rreil-pretty ss = rreil-show-stmts ss
 
-val showrreil/stmts ss =
+val rreil-show-stmts ss =
    case ss of  
       SEM_NIL: ""
-    | SEM_CONS x: showrreil/stmt x.hd +++ "\n" +++ showrreil/stmts x.tl
+    | SEM_CONS x: rreil-show-stmt x.hd +++ "\n" +++ rreil-show-stmts x.tl
    end
 
-val showrreil/stmt s =
+val rreil-show-stmt s =
    case s of
-      SEM_ASSIGN x: showrreil/var x.lhs +++ " = " +++ showrreil/op x.rhs 
-    | SEM_LOAD x: showrreil/var x.lhs +++ " = " showrreil/ptrderef x.size x.address
-    | SEM_STORE x: "*" +++ showrreil/address x.address +++ " = " +++ showrreil/op x.rhs
-    | SEM_LABEL x: showrreil/label x.id
-    | SEM_IF_GOTO_LABEL x: "if (" +++ showrreil/linear x.cond +++ ") goto label " +++ showrreil/label x.label
-    | SEM_IF_GOTO x: "if (" +++ showrreil/linear x.cond +++ ") goto " +++ showrreil/address x.target
-    | SEM_CALL x: "if (" +++ showrreil/linear x.cond +++ ") call " +++ showrreil/address x.target
-    | SEM_RETURN x: "if (" +++ showrreil/linear x.cond +++ ") return " +++ showrreil/address x.target
+      SEM_ASSIGN x: rreil-show-var x.lhs +++ " = " +++ rreil-show-op x.rhs 
+    | SEM_LOAD x: rreil-show-var x.lhs +++ " = " rreil-show-ptrderef x.size x.address
+    | SEM_STORE x: "*" +++ rreil-show-address x.address +++ " = " +++ rreil-show-op x.rhs
+    | SEM_LABEL x: rreil-show-label x.id
+    | SEM_IF_GOTO_LABEL x: "if (" +++ rreil-show-linear x.cond +++ ") goto label " +++ rreil-show-label x.label
+    | SEM_IF_GOTO x: "if (" +++ rreil-show-linear x.cond +++ ") goto " +++ rreil-show-linear x.target
+    | SEM_CALL x: "if (" +++ rreil-show-linear x.cond +++ ") call " +++ rreil-show-address x.target
+    | SEM_RETURN x: "if (" +++ rreil-show-linear x.cond +++ ") return " +++ rreil-show-address x.target
    end
 
-val showrreil/label l = "l" +++ showint l +++ ":"
+val rreil-show-label l = "l" +++ showint l +++ ":"
 
-val showrreil/op op =
+val rreil-show-op op =
    case op of
-      SEM_LIN x: showrreil/arity1 x
-    | SEM_BSWAP x: "bswap" +++ showrreil/arity1 x
-    | SEM_MUL x: "mul" +++ showrreil/arity2 x
-    | SEM_DIV x: "div" +++ showrreil/arity2 x
-    | SEM_DIVS x: "divs" +++ showrreil/arity2 x
-    | SEM_MOD x: "mod" +++ showrreil/arity2 x
-    | SEM_SHL x: "shl" +++ showrreil/arity2 x
-    | SEM_SHR x: "shr" +++ showrreil/arity2 x
-    | SEM_SHRS x: "shrs" +++ showrreil/arity2 x
-    | SEM_AND x: "and" +++ showrreil/arity2 x
-    | SEM_OR x: "or" +++ showrreil/arity2 x
-    | SEM_XOR x: "xor" +++ showrreil/arity2 x
-    | SEM_SX x: "sx[" +++ showint x.fromsize +++ "." +++ showint x.size +++ "](" +++ showrreil/linear x.opnd1 +++ ")"
-    | SEM_ZX x: "zx[" +++ showint x.fromsize +++ "." +++ showint x.size +++ "](" +++ showrreil/linear x.opnd1 +++ ")"
-    | SEM_CMPEQ x: "==" +++ showrreil/cmp x
-    | SEM_CMPNEQ x: "/=" +++ showrreil/cmp x
-    | SEM_CMPLES x: "<=s" +++ showrreil/cmp x
-    | SEM_CMPLEU x: "<=u" +++ showrreil/cmp x
-    | SEM_CMPLTS x: "<s" +++ showrreil/cmp x
-    | SEM_CMPLTU x: "<u" +++ showrreil/cmp x
+      SEM_LIN x: rreil-show-arity1 x
+    | SEM_BSWAP x: "bswap" +++ rreil-show-arity1 x
+    | 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
+    | SEM_SX x: "sx[" +++ showint x.fromsize +++ "." +++ showint x.size +++ "](" +++ rreil-show-linear x.opnd1 +++ ")"
+    | SEM_ZX x: "zx[" +++ showint x.fromsize +++ "." +++ showint x.size +++ "](" +++ rreil-show-linear x.opnd1 +++ ")"
+    | 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
     | SEM_ARB x: "arbitrary[" +++ showint x +++ "]"
    end
 
-val showrreil/arity1 x = "[" +++ showint x.size +++ "](" +++ showrreil/linear x.opnd1 +++ ")"
-val showrreil/arity2 x = "[" +++ showint x.size +++ "](" +++ showrreil/linear x.opnd1 +++ "," +++ showrreil/linear x.opnd2 +++ ")"
-val showrreil/cmp x = "[" +++ showint x.size +++ ".1](" +++ showrreil/linear x.opnd1 +++ "," +++ showrreil/linear x.opnd2 +++ ")"
-val showrreil/ptrderef sz addr = "*[" +++ showint addr.size +++ "." +++ showint sz +++ "](" +++ showrreil/linear addr.address +++ ")"
-val showrreil/address addr = "[" +++ showint addr.size +++ "](" +++ showrreil/linear addr.address +++ ")"
-val showrreil/var x =
+val rreil-show-arity1 x = "[" +++ showint x.size +++ "](" +++ rreil-show-linear x.opnd1 +++ ")"
+val rreil-show-arity2 x = "[" +++ showint x.size +++ "](" +++ rreil-show-linear x.opnd1 +++ "," +++ rreil-show-linear x.opnd2 +++ ")"
+val rreil-show-cmp x = "[" +++ showint x.size +++ ".1](" +++ rreil-show-linear x.opnd1 +++ "," +++ rreil-show-linear x.opnd2 +++ ")"
+val rreil-show-ptrderef sz addr = "*[" +++ showint addr.size +++ "." +++ showint sz +++ "](" +++ rreil-show-linear addr.address +++ ")"
+val rreil-show-address addr = "[" +++ showint addr.size +++ "](" +++ rreil-show-linear addr.address +++ ")"
+val rreil-show-var x =
    case x.offset of
-      0: showrreil/id x.id
-    | o: showrreil/id x.id +++ "/" +++ showint o
+      0: rreil-show-id x.id
+    | o: rreil-show-id x.id +++ "/" +++ showint o
    end
 
-val showrreil/linear lin = 
+val rreil-show-linear lin = 
    case lin of
-      SEM_LIN_VAR x: showrreil/var x
+      SEM_LIN_VAR x: rreil-show-var x
     | SEM_LIN_IMM x: showint x.imm
-    | SEM_LIN_ADD x: showrreil/linear x.opnd1 +++ "+" +++ showrreil/linear x.opnd2
-    | SEM_LIN_SUB x: showrreil/linear x.opnd1 +++ "-" +++ showrreil/linear x.opnd2
+    | 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
     | SEM_LIN_SCALE x:
          case x.imm of
             0: ""
-          | 1: showrreil/linear x.opnd
-          | s: showint s +++ "*" +++ showrreil/linear x.opnd
+          | 1: rreil-show-linear x.opnd
+          | s: showint s +++ "*" +++ rreil-show-linear x.opnd
          end
    end
 
-val showrreil/id id =
+val rreil-show-id id =
    case id of
-      ARCH_R x: show/arch x
+      ARCH_R x: arch-show-id x
     | VIRT_EQ: "EQ"
     | VIRT_NEQ: "NEQ"
     | VIRT_LES: "LES"

specifications/rreil/rreil.ml

@@ -53,7 +53,7 @@ type sem_stmt =
  | SEM_STORE of {address: sem_address, rhs: sem_op}
  | SEM_LABEL of {id: int}
  | SEM_IF_GOTO_LABEL of {cond:sem_linear, label: int}
- | SEM_IF_GOTO of {cond: sem_linear, size:int, target: sem_address}
+ | SEM_IF_GOTO of {cond: sem_linear, size:int, target: sem_linear}
  | SEM_CALL of {cond: sem_linear, size:int, target: sem_address}
  | SEM_RETURN of {cond: sem_linear, size:int, target: sem_address}
 
@@ -90,7 +90,7 @@ val rreil-sizeOf op =
     | SEM_ARB x: x.size
    end
 
-val revSeq stmts =
+val rreil-stmts-rev stmts =
    let
       val lp stmt acc =
          case stmt of
@@ -101,18 +101,6 @@ val revSeq stmts =
       lp stmts SEM_NIL
    end
 
-val resultSize op =
-   case op of
-      SEM_CMPLES x : 1
-    | SEM_MUL x : x.size
-   end
-
-val operandSize op =
-   case op of
-      SEM_CMPLES x : x.size
-    | x : resultSize op
-   end
-
 val var//0 x = {id=x,offset=0}
 val var x = SEM_LIN_VAR x
 
@@ -127,7 +115,7 @@ val mklabel = do
    l <- query $lab;
    l' <- return (l + 1);
    update @{lab=l'};
-   return (l)
+   return l
 end
 
 val /ASSIGN a b = SEM_ASSIGN{lhs=a,rhs=b}
@@ -137,6 +125,7 @@ val /ADD a b = SEM_LIN_ADD{opnd1=a,opnd2=b}
 val /SUB a b = SEM_LIN_SUB{opnd1=a,opnd2=b}
 val /LABEL l = SEM_LABEL{id=l}
 val /IFGOTOLABEL c l = SEM_IF_GOTO_LABEL{cond=c,label=l}
+val /IFGOTO c sz t = SEM_IF_GOTO{cond=c,size=sz,target=t}
 val /GOTOLABEL l = SEM_IF_GOTO_LABEL{cond=SEM_LIN_IMM{imm=1},label=l}
 
 val push insn = do
@@ -172,6 +161,7 @@ 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)
+val ifgoto c sz addr = push (/IFGOTO c sz addr)
 
 val const i = return (SEM_LIN_IMM{imm=i})
 

specifications/x86/x86-pretty.ml

-# vim:ts=3:sw=3:expandtab
+# vim:filetype=sml:ts=3:sw=3:expandtab
 
 export = pretty
 

specifications/x86/x86-rreil-registermapping.ml

 
-val semanticRegisterOf r = 
+val semantic-register-of r = 
    case r of
-      RAX: {id=ARCH_R 0,offset=0,size=64}
-    | RBX: {id=ARCH_R 1,offset=0,size=64}
-    | RBP: {id=ARCH_R 2,offset=0,size=64}
-    | RSP: {id=ARCH_R 3,offset=0,size=64}
-    | EAX: {id=ARCH_R 0,offset=0,size=32}
-    | EBX: {id=ARCH_R 1,offset=0,size=32}
-    | EBP: {id=ARCH_R 2,offset=0,size=32}
-    | ESP: {id=ARCH_R 3,offset=0,size=32}
+       RAX: {id=ARCH_R 0,offset=0,size=64}
+     | RBX: {id=ARCH_R 1,offset=0,size=64}
+     | RCX: {id=ARCH_R 2,offset=0,size=64}
+     | RDX: {id=ARCH_R 3,offset=0,size=64}
+     | R8 : {id=ARCH_R 4,offset=0,size=64}
+     | R9 : {id=ARCH_R 5,offset=0,size=64}
+     | R10: {id=ARCH_R 6,offset=0,size=64}
+     | R11: {id=ARCH_R 7,offset=0,size=64}
+     | R12: {id=ARCH_R 8,offset=0,size=64} 
+     | R13: {id=ARCH_R 9,offset=0,size=64} 
+     | R14: {id=ARCH_R 10,offset=0,size=64} 
+     | R15: {id=ARCH_R 11,offset=0,size=64} 
+     | RSP: {id=ARCH_R 12,offset=0,size=64}
+     | RBP: {id=ARCH_R 13,offset=0,size=64}
+     | RSI: {id=ARCH_R 14,offset=0,size=64}
+     | RDI: {id=ARCH_R 15,offset=0,size=64}
+     | EAX: {id=ARCH_R 0,offset=0,size=32}
+     | EBX: {id=ARCH_R 1,offset=0,size=32}
+     | ECX: {id=ARCH_R 2,offset=0,size=32}
+     | EDX: {id=ARCH_R 3,offset=0,size=32}
+     | R8D: {id=ARCH_R 4,offset=0,size=32}
+     | R9D: {id=ARCH_R 5,offset=0,size=32}
+     | R10D: {id=ARCH_R 6,offset=0,size=32}
+     | R11D: {id=ARCH_R 7,offset=0,size=32}
+     | R12D: {id=ARCH_R 8,offset=0,size=32} 
+     | R13D: {id=ARCH_R 9,offset=0,size=32} 
+     | R14D: {id=ARCH_R 10,offset=0,size=32} 
+     | R15D: {id=ARCH_R 11,offset=0,size=32} 
+     | ESP: {id=ARCH_R 12,offset=0,size=32}
+     | EBP: {id=ARCH_R 13,offset=0,size=32}
+     | ESI: {id=ARCH_R 14,offset=0,size=32}
+     | EDI: {id=ARCH_R 15,offset=0,size=32}
    end
 
-val show/arch r =
+val arch-show-id r =
   case r of
-     0: "RAX"
-   | 1: "RBX"
-   | 2: "RBP"
-   | 3: "RSP"
+     0:  "RAX" 
+   | 1:  "RBX"
+   | 2:  "RCX"
+   | 3:  "RDX"
+   | 4:  "R8"
+   | 5:  "R9"
+   | 6:  "R10"
+   | 7:  "R11"
+   | 8:  "R12"
+   | 9:  "R13"
+   | 10: "R14"
+   | 11: "R15"
+   | 12: "RSP"
+   | 13: "RBP"
+   | 14: "RSI"
+   | 15: "RDI"
    | _ : "ARCH(" +++ showint r +++ ")"
   end