Skip to content
GitLab
Commit 56f4e849 authored by mb0's avatar mb0
Browse files

Merge upstream.

parent e7421a30
Expand all Hide whitespace changes
Inline Side-by-side
detail/closure/from-cps.sml
View file @ 56f4e849
......@@ -9,7 +9,7 @@ end = struct
structure FV = FreeVars
structure FI = FunInfo
structure Map = SymMap
structure Set = SymSet
structure Set = FreeVars.Set
structure Clos = Closure.Stmt
val closure = Atom.atom "env"
......
detail/codegen/c0/c0.sml
View file @ 56f4e849
......@@ -53,13 +53,7 @@ structure PrettyC = struct
in
seq [str "__INVOKE", i n, args (f::xs)]
end
fun fastinvoke (f, xs) =
let
val n = List.length xs
val i = str o Int.toString
in
seq [str "__CALL", i n, args (f::xs)]
end
fun fastinvoke (f, xs) = seq [str "__FCALL", args (f::xs)]
end
structure C0Templates = struct
......@@ -100,6 +94,7 @@ structure C = struct
fun codegen spec =
let
open Layout Pretty
val () = Mangle.reset()
val clos = Spec.get#declarations spec
val exports = Spec.get#exports spec
fun exported f =
......
detail/codegen/c0/runtime.c
View file @ 56f4e849
......@@ -56,6 +56,16 @@ __obj __add (__obj A, __obj B) {
return (x);
}
__obj __sub (__obj A, __obj B) {
__word a = A->z.value;
__word b = B->z.value;
__LOCAL0(x);
__INT_BEGIN(x);
__INT_INIT(a - b);
__INT_END(x);
return (x);
}
/* FIXME */
__obj __sx (__obj x) {
__LOCAL0(y);
......@@ -185,7 +195,7 @@ __obj __runWithState (__obj (*f)(__obj,__obj), __obj s) {
__CLOSURE_BEGIN(envK,1)
__CLOSURE_ADD(k);
__CLOSURE_END(envK,1);
return (__CALL2(f,envK,s));
return (__FCALL(f,envK,s));
}
__obj __eval (__obj (*f)(__obj,__obj), __char* blob, __word sz) {
......@@ -226,7 +236,8 @@ __obj __cont (__obj env, __obj f) {
__CLOSURE_BEGIN(envK,1)
__CLOSURE_ADD(k);
__CLOSURE_END(envK,1);
return (__INVOKE2(f,envK,s));
__LOCAL(ff,__CLOSURE_REF(f,0));
return (__INVOKE3(ff,f,envK,s));
}
__obj __translate (__obj (*f)(__obj,__obj), __obj insn) {
......@@ -239,10 +250,11 @@ __obj __translate (__obj (*f)(__obj,__obj), __obj insn) {
__LABEL_END(k);
__LOCAL0(envK);
__CLOSURE_BEGIN(envK,2)
__CLOSURE_ADD(k);
__CLOSURE_ADD(s);
__CLOSURE_ADD(k);
__CLOSURE_END(envK,2);
return (__CALL2(f,envK,insn));
__LOCAL(ss, __FCALL(f,envK,insn));
return (__RECORD_SELECT(ss,___1));
}
const __char* __fieldName (__word i) {
......
detail/codegen/c0/runtime.h
View file @ 56f4e849
......@@ -37,24 +37,7 @@
#define __INVOKE7(o, closure, u, v, w, x, y, z)\
((__obj(*)(__obj,__obj,__obj,__obj,__obj,__obj,__obj))((o)->label.f))(closure, u, v, w, x, y, z)
#define __CALL1(f,x)\
f(x)
#define __CALL2(f,x,y)\
f(x,y)
#define __CALL3(f,x,y,z)\
f(x,y,z)
#define __CALL4(f,w,x,y,z)\
f(w,x,y,z)
#define __CALL5(f,v,w,x,y,z)\
f(v,w,x,y,z)
#define __CALL6(f,u,v,w,x,y,z)\
f(u,v,w,x,y,z)
#define __CALL7(f,t,u,v,w,x,y,z)\
f(t,u,v,w,x,y,z)
#define __CALL8(f,s,t,u,v,w,x,y,z)\
f(s,t,u,v,w,x,y,z)
#define __CALL9(f,r,s,t,u,v,w,x,y,z)\
f(r,s,t,u,v,w,x,y,z)
#define __FCALL(f,...) f(__VA_ARGS__)
/** ## Integers */
......@@ -393,6 +376,7 @@ __obj __and(__obj,__obj);
__obj __sx(__obj);
__obj __zx(__obj);
__obj __add(__obj,__obj);
__obj __sub(__obj,__obj);
__obj __raise(__obj);
__obj __not(__obj);
__obj __isNil(__obj);
......
detail/codegen/codegen-mangle.sml
View file @ 56f4e849
......@@ -8,9 +8,14 @@ structure Mangle = struct
val variables = SymbolTables.varTable
val fields = SymbolTables.fieldTable
val constructors = SymbolTables.conTable
val names = ref Map.empty : string Map.map ref
val revnames = ref Map.empty : string Map.map ref
val stamp = ref 0
fun reset () =
(names := Map.empty
;revnames := Map.empty
;stamp := 0)
fun getStringOfPrim sym = Atom.toString (VI.getAtom(!variables, sym))
......
detail/codegen/js0/js0.sml
View file @ 56f4e849
......@@ -57,6 +57,7 @@ structure JS0 = struct
fun codegen cpsSpec =
let
val () = Mangle.reset()
fun id s = Id.fromString (Mangle.apply s)
fun field f = PropertyName.fromString (Mangle.applyField f)
fun fieldId f = Id.fromString (Mangle.applyField f)
......
detail/common/pp.sml
View file @ 56f4e849
......@@ -26,6 +26,9 @@ structure Pretty = struct
fun symset item t =
L.listex "{" "}" ";"
(List.map item (SymSet.listItems t))
fun symlistset item t =
L.listex "{" "}" ";"
(List.map item (SymListSet.listItems t))
fun pretty layout = Layout.print (layout, print)
fun prettyTo (os, layout) = Layout.print (layout, fn s => TextIO.output (os, s))
end
detail/cps/cps-opt.sml
View file @ 56f4e849
......@@ -216,7 +216,7 @@ end
(* Currently `FreeVars` is br0k3n considering mutually recursive functions *)
structure FreeVars = struct
structure Map = SymMap
structure Set = SymSet
structure Set = SymListSet
type t = Set.set Map.map
val freevars = ref Map.empty : t ref
......@@ -386,7 +386,7 @@ structure FreeVars = struct
fun layout () =
Pretty.symmap
{key=CPS.PP.var,
item=Pretty.symset CPS.PP.var} (!freevars)
item=Pretty.symlistset CPS.PP.var} (!freevars)
fun dump () = Pretty.prettyTo(TextIO.stdOut, layout())
end
......
detail/cps/from-core.sml
View file @ 56f4e849
......@@ -44,6 +44,7 @@ end = struct
val raisee = get "raise"
val return = get "return"
val add = get "+"
val sub = get "-"
val sx = get "sx"
val zx = get "zx"
......@@ -77,6 +78,18 @@ end = struct
(add, [a, b], body)
end
(* val - a b = %sub(a,b) *)
val sub =
let
val a = fresh "a"
val b = fresh "b"
val primSub = get "%sub"
val body = PRI (primSub, [a, b])
in
(sub, [a, b], body)
end
(* val and a b = %and(a,b) *)
val andd =
let
......@@ -164,7 +177,18 @@ end = struct
(unconsume, [s], body)
end
in
[slice, consume, unconsume, andd, not, ==, concat, raisee, add, sx, zx]
[slice,
consume,
unconsume,
andd,
not,
==,
concat,
raisee,
add,
sx,
zx,
sub]
end
end
......
detail/desugar/inline-decode-patterns.sml
View file @ 56f4e849
......@@ -2,6 +2,18 @@
(**
* ## Inlining of decode patterns.
*)
structure VarAux = struct
val variables = SymbolTables.varTable
fun atomOf x = VarInfo.getAtom (!variables, x)
fun get s = VarInfo.lookup (!variables, Atom.atom s)
fun find s = VarInfo.find (!variables, Atom.atom s)
fun fresh variable = let
val (tab, sym) =
VarInfo.fresh (!variables, variable)
in
sym before SymbolTables.varTable := tab
end
end
structure ASTSubst = struct
val empty = SymMap.empty
......@@ -19,8 +31,8 @@ structure ASTSubst = struct
fun copy x =
let
val name = Aux.atomOf x
val x' = Aux.fresh name
val name = VarAux.atomOf x
val x' = VarAux.fresh name
in
x'
end
......
detail/ml/smlnj/unsealed.cm
View file @ 56f4e849
......@@ -41,8 +41,10 @@ group is
../../semantic/primitives.sml
../../semantic/resolve-symbols.sml
../../semantic/resolve-type-info.sml
../../spec/core.sml
../../spec/spec.sml
../../desugar/desugar-control.sml
../../desugar/desugared-tree.sml
../../desugar/split-declarations.sml
......@@ -53,16 +55,19 @@ group is
../../desugar/desugar-decode-syntax.sml
../../desugar/desugar-monadic-sequences.sml
../../desugar/desugar.sml
../../cps/cps.sml
../../cps/cps-control.sml
../../cps/from-core.sml
../../cps/cps-opt.sml
../../cps/mk-cps-pass.sml
../../cps/cps-passes.sml
../../closure/closure.sml
../../closure/closure-control.sml
../../closure/from-cps.sml
../../closure/closure-passes.sml
../../codegen/codegen-control.sml
../../codegen/codegen-mangle.sml
../../codegen/c0/c0.sml
......
detail/parser/spec.g
View file @ 56f4e849
......@@ -6,7 +6,6 @@
| KW_in ("in")
| KW_do ("do")
| KW_export ("export")
| KW_div ("div")
| KW_else ("else")
| KW_end ("end")
| KW_if ("if")
......@@ -230,7 +229,6 @@ AExp
MExp
: SelectExp
(( "*" => (mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.times))
| "div" => (mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.div))
| "%" => (mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.mod))
) ApplyExp =>
(SR, SelectExp))* =>
......
detail/parser/spec.g.sml
View file @ 56f4e849
......@@ -47,13 +47,12 @@ SpecTokens = struct
| KW_if
| KW_end
| KW_else
| KW_div
| KW_export
| KW_do
| KW_in
| KW_case
val allToks = [EOF, WILD, COLON, BAR, SEMI, COMMA, TILDE, SLASH, TIMES, MINUS, PLUS, CONCAT, RCB, LCB, RB, LB, RP, LP, DOT, TICK, EQ, BIND, SELECT, WITH, KW_or, KW_and, KW_type, KW_then, KW_raise, KW_granularity, KW_of, KW_mod, KW_val, KW_let, KW_if, KW_end, KW_else, KW_div, KW_export, KW_do, KW_in, KW_case]
val allToks = [EOF, WILD, COLON, BAR, SEMI, COMMA, TILDE, SLASH, TIMES, MINUS, PLUS, CONCAT, RCB, LCB, RB, LB, RP, LP, DOT, TICK, EQ, BIND, SELECT, WITH, KW_or, KW_and, KW_type, KW_then, KW_raise, KW_granularity, KW_of, KW_mod, KW_val, KW_let, KW_if, KW_end, KW_else, KW_export, KW_do, KW_in, KW_case]
fun toString tok =
(case (tok)
......@@ -103,7 +102,6 @@ SpecTokens = struct
| (KW_if) => "if"
| (KW_end) => "end"
| (KW_else) => "else"
| (KW_div) => "div"
| (KW_export) => "export"
| (KW_do) => "do"
| (KW_in) => "in"
......@@ -157,7 +155,6 @@ SpecTokens = struct
| (KW_if) => false
| (KW_end) => false
| (KW_else) => false
| (KW_div) => false
| (KW_export) => false
| (KW_do) => false
| (KW_in) => false
......@@ -333,9 +330,7 @@ fun AExp_PROD_1_ACT (SR, MExp, SR_SPAN : (Lex.pos * Lex.pos), MExp_SPAN : (Lex.p
mark PT.MARKexp (FULL_SPAN, mkLBinExp (MExp, SR)))
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_1_ACT (TIMES, SelectExp, TIMES_SPAN : (Lex.pos * Lex.pos), SelectExp_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
( mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.times))
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2_ACT (SelectExp, KW_div, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_div_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
( mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.div))
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_3_ACT (SelectExp, KW_mod, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_mod_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2_ACT (SelectExp, KW_mod, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_mod_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
( mark PT.MARKinfixop (FULL_SPAN, PT.OPinfixop Op.mod))
fun MExp_PROD_1_SUBRULE_1_PROD_1_ACT (SR, SelectExp, ApplyExp, SR_SPAN : (Lex.pos * Lex.pos), SelectExp_SPAN : (Lex.pos * Lex.pos), ApplyExp_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)) =
(
......@@ -614,10 +609,6 @@ fun matchKW_else strm = (case (lex(strm))
of (Tok.KW_else, span, strm') => ((), span, strm')
| _ => fail()
(* end case *))
fun matchKW_div strm = (case (lex(strm))
of (Tok.KW_div, span, strm') => ((), span, strm')
| _ => fail()
(* end case *))
fun matchKW_export strm = (case (lex(strm))
of (Tok.KW_export, span, strm') => ((), span, strm')
| _ => fail()
......@@ -947,8 +938,7 @@ and MonadicExp_NT (strm) = let
(case (lex(strm))
of (Tok.ID(_), _, strm') =>
(case (lex(strm'))
of (Tok.KW_div, _, strm') => MonadicExp_PROD_1(strm)
| (Tok.KW_end, _, strm') => MonadicExp_PROD_1(strm)
of (Tok.KW_end, _, strm') => MonadicExp_PROD_1(strm)
| (Tok.KW_let, _, strm') => MonadicExp_PROD_1(strm)
| (Tok.KW_mod, _, strm') => MonadicExp_PROD_1(strm)
| (Tok.KW_and, _, strm') => MonadicExp_PROD_1(strm)
......@@ -1117,27 +1107,18 @@ and MExp_NT (strm) = let
FULL_SPAN, strm')
end
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2 (strm) = let
val (KW_div_RES, KW_div_SPAN, strm') = matchKW_div(strm)
val FULL_SPAN = (#1(KW_div_SPAN), #2(KW_div_SPAN))
in
(UserCode.MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2_ACT (SelectExp_RES, KW_div_RES, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_div_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)),
FULL_SPAN, strm')
end
fun MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_3 (strm) = let
val (KW_mod_RES, KW_mod_SPAN, strm') = matchKW_mod(strm)
val FULL_SPAN = (#1(KW_mod_SPAN), #2(KW_mod_SPAN))
in
(UserCode.MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_3_ACT (SelectExp_RES, KW_mod_RES, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_mod_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)),
(UserCode.MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2_ACT (SelectExp_RES, KW_mod_RES, SelectExp_SPAN : (Lex.pos * Lex.pos), KW_mod_SPAN : (Lex.pos * Lex.pos), FULL_SPAN : (Lex.pos * Lex.pos)),
FULL_SPAN, strm')
end
in
(case (lex(strm))
of (Tok.KW_mod, _, strm') =>
MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_3(strm)
MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2(strm)
| (Tok.TIMES, _, strm') =>
MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_1(strm)
| (Tok.KW_div, _, strm') =>
MExp_PROD_1_SUBRULE_1_PROD_1_SUBRULE_1_PROD_2(strm)
| _ => fail()
(* end case *))
end
......@@ -1151,8 +1132,7 @@ and MExp_NT (strm) = let
FULL_SPAN, strm')
end
fun MExp_PROD_1_SUBRULE_1_PRED (strm) = (case (lex(strm))
of (Tok.KW_div, _, strm') => true
| (Tok.KW_mod, _, strm') => true
of (Tok.KW_mod, _, strm') => true
| (Tok.TIMES, _, strm') => true
| _ => false
(* end case *))
......
detail/parser/spec.l
View file @ 56f4e849
......@@ -97,7 +97,6 @@
<INITIAL>"end" => (T.KW_end);
<INITIAL>"do" => (T.KW_do);
<INITIAL>"in" => (T.KW_in);
<INITIAL>"div" => (T.KW_div);
<INITIAL>"andalso" => (T.KW_and);
<INITIAL>"orelse" => (T.KW_or);
<INITIAL>"<-" => (T.BIND);
......
detail/parser/spec.l.sml
View file @ 56f4e849
This diff is collapsed.
detail/semantic/symbol-table-type.sml
View file @ 56f4e849
......@@ -42,7 +42,7 @@ end
structure SymbolTable :> SymbolTableSig = struct
val concisePrint : bool = true
val concisePrint : bool = false
structure SymbolTable = IntRedBlackMap
structure Reverse = AtomRedBlackMap
......@@ -185,6 +185,7 @@ end
structure SymMap = RedBlackMapFn(ord_symid)
structure SymSet = RedBlackSetFn(ord_symid)
structure SymListSet = ListSetFn(ord_symid)
structure SpanMap = RedBlackMapFn(struct
type ord_key = Error.span
......
examples/rreil-stack.s
View file @ 56f4e849
......@@ -5,15 +5,24 @@ type sem_id =
ARCH_RAX
| ARCH_RBX
| ARCH_RCX
| VIRT_EQ
| VIRT_LES
| VIRT_LEU
| VIRT_LTS
| VIRT_LTU
| ARCH_RBP
| ARCH_ZF
| ARCH_CF
| ARCH_SF
| ARCH_OF
| ARCH_PF
| ARCH_AF
| VIRT_EQ # ==
| VIRT_NEQ # /=
| VIRT_LES # <=s
| VIRT_LEU # <=u
| VIRT_LTS # <s
| VIRT_LTU # <u
| VIRT_T of int
type sem_arity1 = {size: int, opnd1: sem_linear}
type sem_arity2 = {size: int, opnd1: sem_linear, opnd2: sem_linear}
type sem_cmp = {size: int, opnd1: sem_linear, opnd2: sem_linear}
type sem_address = {size: int, address: sem_linear}
type sem_var = {id:sem_id, offset:int}
......@@ -21,29 +30,40 @@ type sem_var = {id:sem_id, offset:int}
type sem_linear =
SEM_LIN_VAR of sem_var
| SEM_LIN_IMM of {imm:int}
| SEM_LIN_ADD of {opnd1:sem_linear, opnd2:sem_linear}
| SEM_LIN_SUB of {opnd1:sem_linear, opnd2:sem_linear}
| SEM_LIN_ADD of {opnd1: sem_linear, opnd2: sem_linear}
| SEM_LIN_SUB of {opnd1: sem_linear, opnd2: sem_linear}
| SEM_LIN_SCALE of {imm:int, opnd:sem_linear}
type sem_op =
SEM_LIN of sem_arity1
| SEM_BSWAP of sem_arity1
| SEM_MUL of sem_arity2
| SEM_DIV of sem_arity2
| SEM_BSWAP of sem_arity1
| SEM_CMPEQ of sem_arity2
| SEM_CMPLES of sem_arity2
| SEM_CMPLEU of sem_arity2
| SEM_CMPLTS of sem_arity2
| SEM_CMPLTU of sem_arity2
| 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}
type sem_stmt =
SEM_ASSIGN of {lhs: sem_var, rhs: sem_op}
| SEM_LOAD of {lhs: sem_var, size: int, address: sem_address}
| SEM_STORE of {address: sem_address, size: int, rhs: sem_linear}
| SEM_STORE of {address: sem_address, rhs: sem_op}
| SEM_LABEL of {id: int}
| SEM_BRANCH_TO_LABEL of {target: int}
| SEM_BRANCH of {cond: sem_linear, size:int, target: sem_address}
| SEM_IF_GOTO_LABEL of {cond:sem_linear, label: int}
| SEM_IF_GOTO of {cond: sem_linear, size:int, target: sem_address}
| SEM_CALL of {cond: sem_linear, size:int, target: sem_address}
| SEM_RETURN of {cond: sem_linear, size:int, target: sem_address}
......@@ -51,6 +71,21 @@ type sem_stmts =
SEM_CONS of {hd:sem_stmt, tl:sem_stmts}
| SEM_NIL
type sem_writeback =
SEM_WRITE_VAR of {size: int, id: sem_var}
| SEM_WRITE_MEM of {size: int, address: sem_linear}
val revSeq stmts =
let
val lp stmt acc =
case stmt of
SEM_NIL: acc
| SEM_CONS x: lp ($tl x) (SEM_CONS{hd= $hd x, tl=acc})
end
in
lp stmts SEM_NIL
end
val resultSize op =
case op of
SEM_CMPLES x : 1
......@@ -67,8 +102,10 @@ val semanticRegisterOf r =
case r of
RAX: {id=ARCH_RAX,offset=0,size=64}
| RBX: {id=ARCH_RBX,offset=0,size=64}
| RBP: {id=ARCH_RBP,offset=0,size=64}
| EAX: {id=ARCH_RAX,offset=0,size=32}
| EBX: {id=ARCH_RBX,offset=0,size=32}
| EBP: {id=ARCH_RBP,offset=0,size=32}
end
val guessSizeOf dst/src1 src2 =
......@@ -82,18 +119,41 @@ val guessSizeOf dst/src1 src2 =
end
end
val var//0 x = SEM_LIN_VAR{id=x,offset=0}
val sizeOf op =
case op of
REG r: return ($size (semanticRegisterOf r))
| MEM x: return ($sz x)
| IMM8 i: return (8)
| IMM16 i: return (16)
| IMM32 i: return (32)
| IMM64 i: return (64)
end
val var//0 x = {id=x,offset=0}
val var x = SEM_LIN_VAR x
val temp = do
val mktemp = do
t <- query $tmp;
t' <- return (t + 1);
update @{tmp=t'};
return {id=VIRT_T t,offset=0}
end
val mklabel = do
l <- query $lab;
l' <- return (l + 1);
update @{lab=l'};
return (l)
end
val /ASSIGN a b = SEM_ASSIGN{lhs=a,rhs=b}
val /LOAD sz a b = SEM_LOAD{lhs=a,size=sz,address=b}
val /STORE a b = SEM_STORE{address=a,rhs=b}
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 /GOTOLABEL l = SEM_IF_GOTO_LABEL{cond=SEM_LIN_IMM{imm=1},label=l}
val push insn = do
tl <- query $stack;
......@@ -101,16 +161,38 @@ val push insn = do
end
val mov sz a b = push (/ASSIGN a (SEM_LIN{size=sz,opnd1=b}))
val undef sz a = push (/ASSIGN a (SEM_ARB{size=sz}))
val load sz a psz b = push (/LOAD sz a {size=psz,address=b})
val store a b = push (/STORE a b)
val add sz a b c = push (/ASSIGN a (SEM_LIN{size=sz,opnd1= /ADD b c}))
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}))