Permalink
Browse files

Simplify memop

  • Loading branch information...
rossberg committed Aug 24, 2016
1 parent d924eff commit 4dc09e3d2f73d5c3832e8928ce6ce79475acafce
View
@@ -165,11 +165,6 @@ let testop = oper (IntOp.testop, FloatOp.testop)
let relop = oper (IntOp.relop, FloatOp.relop)
let cvtop = oper (IntOp.cvtop, FloatOp.cvtop)
let memop name {ty; align; offset} =
value_type ty ^ "." ^ name ^
(if offset = 0L then "" else " offset=" ^ int64 offset) ^
(if align = size ty then "" else " align=" ^ int align)
let mem_size = function
| Memory.Mem8 -> "8"
| Memory.Mem16 -> "16"
@@ -179,11 +174,20 @@ let extension = function
| Memory.SX -> "_s"
| Memory.ZX -> "_u"
let extop {memop = op; sz; ext} =
memop ("load" ^ mem_size sz ^ extension ext) op
let memop name {ty; align; offset; _} =
value_type ty ^ "." ^ name ^
(if offset = 0L then "" else " offset=" ^ int64 offset) ^
(if align = size ty then "" else " align=" ^ int align)
let loadop op =
match op.sz with
| None -> memop "load" op
| Some (sz, ext) -> memop ("load" ^ mem_size sz ^ extension ext) op
let wrapop {memop = op; sz} =
memop ("store" ^ mem_size sz) op
let storeop op =
match op.sz with
| None -> memop "store" op
| Some sz -> memop ("store" ^ mem_size sz) op
(* Expressions *)
@@ -215,10 +219,8 @@ let rec expr e =
| TeeLocal x -> Atom ("tee_local " ^ var x)
| GetGlobal x -> Atom ("get_global " ^ var x)
| SetGlobal x -> Atom ("set_global " ^ var x)
| Load op -> Atom (memop "load" op)
| Store op -> Atom (memop "store" op)
| LoadPacked op -> Atom (extop op)
| StorePacked op -> Atom (wrapop op)
| Load op -> Atom (loadop op)
| Store op -> Atom (storeop op)
| Const lit -> Atom (constop lit ^ " " ^ value lit)
| Unary op -> Atom (unop op)
| Binary op -> Atom (binop op)
View
@@ -135,55 +135,46 @@ let encode m =
| CallIndirect x -> op 0x17; var x
| CallImport x -> op 0x18; var x
| Load ({ty = I32Type; _} as mo) -> op 0x2a; memop mo
| Load ({ty = I64Type; _} as mo) -> op 0x2b; memop mo
| Load ({ty = F32Type; _} as mo) -> op 0x2c; memop mo
| Load ({ty = F64Type; _} as mo) -> op 0x2d; memop mo
| Store ({ty = I32Type; _} as mo) -> op 0x33; memop mo
| Store ({ty = I64Type; _} as mo) -> op 0x34; memop mo
| Store ({ty = F32Type; _} as mo) -> op 0x35; memop mo
| Store ({ty = F64Type; _} as mo) -> op 0x36; memop mo
| LoadPacked {memop = {ty = I32Type; _} as mo; sz = Mem8; ext = SX} ->
| Load ({ty = I32Type; sz = None; _} as mo) -> op 0x2a; memop mo
| Load ({ty = I64Type; sz = None; _} as mo) -> op 0x2b; memop mo
| Load ({ty = F32Type; sz = None; _} as mo) -> op 0x2c; memop mo
| Load ({ty = F64Type; sz = None; _} as mo) -> op 0x2d; memop mo
| Load ({ty = I32Type; sz = Some (Mem8, SX); _} as mo) ->
op 0x20; memop mo
| LoadPacked {memop = {ty = I32Type; _} as mo; sz = Mem8; ext = ZX} ->
| Load ({ty = I32Type; sz = Some (Mem8, ZX); _} as mo) ->
op 0x21; memop mo
| LoadPacked {memop = {ty = I32Type; _} as mo; sz = Mem16; ext = SX} ->
| Load ({ty = I32Type; sz = Some (Mem16, SX); _} as mo) ->
op 0x22; memop mo
| LoadPacked {memop = {ty = I32Type; _} as mo; sz = Mem16; ext = ZX} ->
| Load ({ty = I32Type; sz = Some (Mem16, ZX); _} as mo) ->
op 0x23; memop mo
| LoadPacked {memop = {ty = I32Type; _}; sz = Mem32; _} ->
| Load {ty = I32Type; sz = Some (Mem32, _); _} ->
assert false
| LoadPacked {memop = {ty = I64Type; _} as mo; sz = Mem8; ext = SX} ->
| Load ({ty = I64Type; sz = Some (Mem8, SX); _} as mo) ->
op 0x24; memop mo
| LoadPacked {memop = {ty = I64Type; _} as mo; sz = Mem8; ext = ZX} ->
| Load ({ty = I64Type; sz = Some (Mem8, ZX); _} as mo) ->
op 0x25; memop mo
| LoadPacked {memop = {ty = I64Type; _} as mo; sz = Mem16; ext = SX} ->
| Load ({ty = I64Type; sz = Some (Mem16, SX); _} as mo) ->
op 0x26; memop mo
| LoadPacked {memop = {ty = I64Type; _} as mo; sz = Mem16; ext = ZX} ->
| Load ({ty = I64Type; sz = Some (Mem16, ZX); _} as mo) ->
op 0x27; memop mo
| LoadPacked {memop = {ty = I64Type; _} as mo; sz = Mem32; ext = SX} ->
| Load ({ty = I64Type; sz = Some (Mem32, SX); _} as mo) ->
op 0x28; memop mo
| LoadPacked {memop = {ty = I64Type; _} as mo; sz = Mem32; ext = ZX} ->
| Load ({ty = I64Type; sz = Some (Mem32, ZX); _} as mo) ->
op 0x29; memop mo
| LoadPacked {memop = {ty = F32Type | F64Type; _}; _} ->
| Load {ty = F32Type | F64Type; sz = Some _; _} ->
assert false
| StorePacked {memop = {ty = I32Type; _} as mo; sz = Mem8} ->
op 0x2e; memop mo
| StorePacked {memop = {ty = I32Type; _} as mo; sz = Mem16} ->
op 0x2f; memop mo
| StorePacked {memop = {ty = I32Type; _}; sz = Mem32} ->
assert false
| StorePacked {memop = {ty = I64Type; _} as mo; sz = Mem8} ->
op 0x30; memop mo
| StorePacked {memop = {ty = I64Type; _} as mo; sz = Mem16} ->
op 0x31; memop mo
| StorePacked {memop = {ty = I64Type; _} as mo; sz = Mem32} ->
op 0x32; memop mo
| StorePacked {memop = {ty = F32Type | F64Type; _}; _} ->
assert false
| Store ({ty = I32Type; sz = None; _} as mo) -> op 0x33; memop mo
| Store ({ty = I64Type; sz = None; _} as mo) -> op 0x34; memop mo
| Store ({ty = F32Type; sz = None; _} as mo) -> op 0x35; memop mo
| Store ({ty = F64Type; sz = None; _} as mo) -> op 0x36; memop mo
| Store ({ty = I32Type; sz = Some Mem8; _} as mo) -> op 0x2e; memop mo
| Store ({ty = I32Type; sz = Some Mem16; _} as mo) -> op 0x2f; memop mo
| Store {ty = I32Type; sz = Some Mem32; _} -> assert false
| Store ({ty = I64Type; sz = Some Mem8; _} as mo) -> op 0x30; memop mo
| Store ({ty = I64Type; sz = Some Mem16; _} as mo) -> op 0x31; memop mo
| Store ({ty = I64Type; sz = Some Mem32; _} as mo) -> op 0x32; memop mo
| Store {ty = F32Type | F64Type; sz = Some _; _} -> assert false
| GrowMemory -> op 0x39
| CurrentMemory -> op 0x3b
@@ -1,51 +0,0 @@
--- host/encode.ml
+++ host/encode.ml
@@ -105,31 +105,30 @@
let rec expr e =
match e.it with
| Nop -> op 0x00
- | Block es -> op 0x01; list expr es; op 0x17
- | Loop es -> op 0x02; list expr es; op 0x17
+ | Block es -> op 0x01; list expr es; op 0x0f
+ | Loop es -> op 0x02; list expr es; op 0x0f
| If (e, es1, es2) ->
expr e; op 0x03; list expr es1;
- if es2 <> [] then op 0x04; list expr es2; op 0x17
+ if es2 <> [] then op 0x04; list expr es2; op 0x0f
| Select (e1, e2, e3) -> expr e1; expr e2; expr e3; op 0x05
| Br (x, eo) -> opt expr eo; op 0x06; arity1 eo; var x
| Br_if (x, eo, e) -> opt expr eo; expr e; op 0x07; arity1 eo; var x
| Br_table (xs, x, eo, e) ->
opt expr eo; expr e; op 0x08; arity1 eo; vec var32 xs; var32 x
-
- | Ast.I32_const c -> op 0x0a; vs32 c.it
- | Ast.I64_const c -> op 0x0b; vs64 c.it
- | Ast.F32_const c -> op 0x0c; f32 c.it
- | Ast.F64_const c -> op 0x0d; f64 c.it
-
- | Ast.Get_local x -> op 0x0e; var x
- | Ast.Set_local (x, e) -> unary e 0x0f; var x
- | Ast.Tee_local (x, e) -> unary e 0x10; var x
-
- | Ast.Call (x, es) -> nary es 0x12; var x
- | Ast.Call_import (x, es) -> nary es 0x1f; var x
- | Ast.Call_indirect (x, e, es) -> expr e; nary es 0x13; var x
- | Ast.Return eo -> nary1 eo 0x14
- | Ast.Unreachable -> op 0x15
+ | Ast.Return eo -> nary1 eo 0x09
+ | Ast.Unreachable -> op 0x0a
+
+ | Ast.I32_const c -> op 0x10; vs32 c.it
+ | Ast.I64_const c -> op 0x11; vs64 c.it
+ | Ast.F32_const c -> op 0x12; f32 c.it
+ | Ast.F64_const c -> op 0x13; f64 c.it
+
+ | Ast.Get_local x -> op 0x14; var x
+ | Ast.Set_local (x, e) -> unary e 0x15; var x
+
+ | Ast.Call (x, es) -> nary es 0x16; var x
+ | Ast.Call_indirect (x, e, es) -> expr e; nary es 0x17; var x
+ | Ast.Call_import (x, es) -> nary es 0x18; var x
| I32_load8_s (o, a, e) -> unary e 0x20; memop o a
| I32_load8_u (o, a, e) -> unary e 0x21; memop o a
View
@@ -62,9 +62,10 @@ type testop = (I32Op.testop, I64Op.testop, F32Op.testop, F64Op.testop) op
type relop = (I32Op.relop, I64Op.relop, F32Op.relop, F64Op.relop) op
type cvtop = (I32Op.cvtop, I64Op.cvtop, F32Op.cvtop, F64Op.cvtop) op
type memop = {ty : value_type; align : int; offset : Memory.offset}
type extop = {memop : memop; sz : Memory.mem_size; ext : Memory.extension}
type wrapop = {memop : memop; sz : Memory.mem_size}
type 'a memop =
{ty : value_type; align : int; offset : Memory.offset; sz : 'a option}
type loadop = (Memory.mem_size * Memory.extension) memop
type storeop = Memory.mem_size memop
(* Expressions *)
@@ -93,10 +94,8 @@ and expr' =
| TeeLocal of var (* write local variable and keep value *)
| GetGlobal of var (* read global variable *)
| SetGlobal of var (* write global variable *)
| Load of memop (* read memory at address *)
| Store of memop (* write memory at address *)
| LoadPacked of extop (* read memory at address and extend *)
| StorePacked of wrapop (* wrap and write to memory at address *)
| Load of loadop (* read memory at address *)
| Store of storeop (* write memory at address *)
| Const of literal (* constant *)
| Unary of unop (* unary numeric operator *)
| Binary of binop (* binary numeric operator *)
View
@@ -113,6 +113,26 @@ let type_cvtop at = function
(* Expressions *)
let check_memop (c : context) (memop : 'a memop) get_sz at =
ignore (memory c at);
require (memop.offset >= 0L) at "negative offset";
require (memop.offset <= 0xffffffffL) at "offset too large";
require (Lib.Int.is_power_of_two memop.align) at
"alignment must be a power of two";
require (memop.align <= size memop.ty) at
"alignment must not be larger than natural";
let sz = get_sz memop.sz in
require (sz = None || memop.ty = I64Type || sz <> Some Memory.Mem32) at
"memory size too big"
let check_arity n at =
require (n <= 1) at "invalid result arity, larger than 1 is not (yet) allowed"
let check_result_arity r at =
match r with
| Stack ts -> check_arity (List.length ts) at
| Bot -> ()
(*
* check_expr : context -> expr_type_future -> expr -> unit
*
@@ -222,21 +242,11 @@ let rec check_expr (c : context) (e : expr) (stack : stack_type) : op_type =
[global c x] --> Stack []
| Load memop ->
check_memop c memop e.at;
check_memop c memop (Lib.Option.map fst) e.at;
[I32Type] --> Stack [memop.ty]
| Store memop ->
check_memop c memop e.at;
[I32Type; memop.ty] --> Stack []
| LoadPacked {memop; sz; _} ->
check_memop c memop e.at;
check_mem_size memop.ty sz e.at;
[I32Type] --> Stack [memop.ty]
| StorePacked {memop; sz} ->
check_memop c memop e.at;
check_mem_size memop.ty sz e.at;
check_memop c memop (fun sz -> sz) e.at;
[I32Type; memop.ty] --> Stack []
| Const v ->
@@ -313,24 +323,6 @@ and check_block (c : context) (es : expr list) : result_type =
| Bot -> Bot
| Stack ts3 -> Stack (ts1 @ ts3)
and check_memop c memop at =
ignore (memory c at);
require (memop.offset >= 0L) at "negative offset";
require (memop.offset <= 0xffffffffL) at "offset too large";
require (Lib.Int.is_power_of_two memop.align) at "alignment must be a power of two";
require (memop.align <= size memop.ty) at "alignment must not be larger than natural"
and check_mem_size ty sz at =
require (ty = I64Type || sz <> Memory.Mem32) at "memory size too big"
and check_arity n at =
require (n <= 1) at "invalid result arity, larger than 1 is not (yet) allowed"
and check_result_arity r at =
match r with
| Stack ts -> check_arity (List.length ts) at
| Bot -> ()
(* Functions & Constants *)
View
@@ -209,25 +209,23 @@ let rec step_expr (c : config) (vs : value stack) (e : expr)
global c x := v;
vs', []
| Load {offset; ty; _}, I32 i :: vs' ->
| Load {offset; ty; sz; _}, I32 i :: vs' ->
let addr = I64_convert.extend_u_i32 i in
(try Memory.load (memory c e.at) addr offset ty :: vs', []
with exn -> memory_error e.at exn)
| Store {offset; _}, v :: I32 i :: vs' ->
let addr = I64_convert.extend_u_i32 i in
(try Memory.store (memory c e.at) addr offset v
with exn -> memory_error e.at exn);
vs', []
| LoadPacked {memop = {offset; ty; _}; sz; ext}, I32 i :: vs' ->
let addr = I64_convert.extend_u_i32 i in
(try Memory.load_packed (memory c e.at) addr offset sz ext ty :: vs', []
with exn -> memory_error e.at exn)
| StorePacked {memop = {offset; _}; sz}, v :: I32 i :: vs' ->
let v =
try
match sz with
| None -> Memory.load (memory c e.at) addr offset ty
| Some (sz, ext) ->
Memory.load_packed sz ext (memory c e.at) addr offset ty
with exn -> memory_error e.at exn
in v :: vs', []
| Store {offset; sz; _}, v :: I32 i :: vs' ->
let addr = I64_convert.extend_u_i32 i in
(try Memory.store_packed (memory c e.at) addr offset sz v
(try
match sz with
| None -> Memory.store (memory c e.at) addr offset v
| Some sz -> Memory.store_packed sz (memory c e.at) addr offset v
with exn -> memory_error e.at exn);
vs', []
View
@@ -129,7 +129,7 @@ let loadn_sx mem n ea =
let shift = 64 - (8 * n) in
Int64.shift_right (Int64.shift_left v shift) shift
let load_packed mem a o sz ext t =
let load_packed sz ext mem a o t =
let ea = effective_address a o in
match sz, ext, t with
| Mem8, ZX, I32Type -> I32 (Int64.to_int32 (loadn mem 1 ea))
@@ -144,7 +144,7 @@ let load_packed mem a o sz ext t =
| Mem32, SX, I64Type -> I64 (loadn_sx mem 4 ea)
| _ -> raise Type
let store_packed mem a o sz v =
let store_packed sz mem a o v =
let ea = effective_address a o in
match sz, v with
| Mem8, I32 x -> storen mem 1 ea (Int64.of_int32 x)
View
@@ -26,7 +26,7 @@ val grow : memory -> size -> unit (* raise SizeOverflow, OutOfMemory *)
val load : memory -> address -> offset -> value_type -> value
val store : memory -> address -> offset -> value -> unit
val load_packed :
memory -> address -> offset -> mem_size -> extension -> value_type -> value
val store_packed : memory -> address -> offset -> mem_size -> value -> unit
mem_size -> extension -> memory -> address -> offset -> value_type -> value
val store_packed : mem_size -> memory -> address -> offset -> value -> unit
val blit : memory -> address -> string -> unit
Oops, something went wrong.

0 comments on commit 4dc09e3

Please sign in to comment.