From 21926b67d53de88dc94d00161039fd99097f3b43 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Sat, 29 Aug 2015 17:28:25 +0200 Subject: [PATCH] Simplify memops --- ml-proto/README.md | 13 ++--- ml-proto/src/ast.ml | 3 +- ml-proto/src/check.ml | 37 +++++-------- ml-proto/src/eval.ml | 8 +-- ml-proto/src/lexer.mll | 43 +++++---------- ml-proto/src/memory.ml | 108 ++++++++++++++++---------------------- ml-proto/src/memory.mli | 11 ++-- ml-proto/test/memory.wasm | 44 ++++++++-------- 8 files changed, 106 insertions(+), 161 deletions(-) diff --git a/ml-proto/README.md b/ml-proto/README.md index 259acaa2e4..83b7c9f763 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -152,18 +152,15 @@ The S-expression syntax is defined in `parser.mly`, the opcodes in `lexer.mll`. ``` type: i32 | i64 | f32 | f64 -memtype: | i8 | i16 - +size: 8 | 16 | 32 | 64 value: | var: | $ unop: neg | abs | not | ... binop: add | sub | mul | ... relop: eq | neq | lt | ... -sign: s|u -align: 1|2|4|8|... -memop: (.)?(.)? -cvtop: trunc_s | trunc_u | extend_s | extend_u | ... +cvtop: wrap | trunc_ | extend_ | ... +sign: s | u expr: ( nop ) @@ -183,8 +180,8 @@ expr: ( set_local ) ( load_global ) ( store_global ) - ( .load ) - ( .store ) + ( .load(_)?(/)? ) + ( .store(/)? ) ( .const ) ( . ) ( . ) diff --git a/ml-proto/src/ast.ml b/ml-proto/src/ast.ml index a48839da0b..2332781c71 100644 --- a/ml-proto/src/ast.ml +++ b/ml-proto/src/ast.ml @@ -62,7 +62,8 @@ type binop = (Int32Op.binop, Int64Op.binop, Float32Op.binop, Float64Op.binop) op type relop = (Int32Op.relop, Int64Op.relop, Float32Op.relop, Float64Op.relop) op type cvt = (Int32Op.cvt, Int64Op.cvt, Float32Op.cvt, Float64Op.cvt) op -type memop = {ty : Types.value_type; mem : Memory.mem_type; align : int} +type memop = + {ty : Types.value_type; size : int; align : int; signed : bool option} (* Expressions *) diff --git a/ml-proto/src/check.ml b/ml-proto/src/check.ml index 92fe065651..e65cc0b388 100644 --- a/ml-proto/src/check.ml +++ b/ml-proto/src/check.ml @@ -55,18 +55,6 @@ let nary = List.map (fun ty -> [ty]) (* Type Synthesis *) -let type_mem = function - | Memory.SInt8Mem -> Int32Type - | Memory.SInt16Mem -> Int32Type - | Memory.SInt32Mem -> Int32Type - | Memory.SInt64Mem -> Int64Type - | Memory.UInt8Mem -> Int32Type - | Memory.UInt16Mem -> Int32Type - | Memory.UInt32Mem -> Int32Type - | Memory.UInt64Mem -> Int64Type - | Memory.Float32Mem -> Float32Type - | Memory.Float64Mem -> Float64Type - let type_value = Values.type_of let type_unop = Values.type_of let type_binop = Values.type_of @@ -189,12 +177,12 @@ let rec check_expr c ts e = check_type [] ts e.at | Load (memop, e1) -> - check_memop memop e.at; + check_memop memop false e.at; check_expr c [Int32Type] e1; - check_type [type_mem memop.mem] ts e.at + check_type [memop.ty] ts e.at | Store (memop, e1, e2) -> - check_memop memop e.at; + check_memop memop true e.at; check_expr c [Int32Type] e1; check_expr c [memop.ty] e2; check_type [] ts e.at @@ -239,17 +227,16 @@ and check_arm c t ts arm = check_literal c [t] l; check_expr c (if fallthru then [] else ts) e -and check_memop {ty; mem; align} at = +and check_memop {ty; size; align; signed} is_store at = require (Lib.Int.is_power_of_two align) at "non-power-of-two alignment"; - let open Memory in - match mem, ty with - | (SInt8Mem | SInt16Mem | SInt32Mem), Int32Type - | (UInt8Mem | UInt16Mem | UInt32Mem), Int32Type - | (SInt8Mem | SInt16Mem | SInt32Mem | SInt64Mem), Int64Type - | (UInt8Mem | UInt16Mem | UInt32Mem | UInt64Mem), Int64Type - | Float32Mem, Float32Type - | Float64Mem, Float64Type -> () - | _ -> error at "type-inconsistent memory operator" + match ty, size, (signed, is_store) with + | Int32Type, (8 | 16), ((Some _, false) | (None, true)) + | Int32Type, 32, (None, _) + | Int64Type, (8 | 16 | 32), ((Some _, false) | (None, true)) + | Int64Type, 64, (None, _) + | Float32Type, 32, (None, _) + | Float64Type, 64, (None, _) -> () + | _ -> error at "invalid memory operator" (* diff --git a/ml-proto/src/eval.ml b/ml-proto/src/eval.ml index 08931c8853..a3c7fb6358 100644 --- a/ml-proto/src/eval.ml +++ b/ml-proto/src/eval.ml @@ -162,15 +162,15 @@ let rec eval_expr c e = global c x := v1; [] - | Load ({mem; ty; _}, e1) -> + | Load ({ty; size; signed; _}, e1) -> let v1 = unary (eval_expr c e1) e1.at in - (try [Memory.load c.modul.memory (Memory.address_of_value v1) mem ty] + (try [Memory.load c.modul.memory (Memory.address_of_value v1) size ty signed] with exn -> memory_error e.at exn) - | Store ({mem; _}, e1, e2) -> + | Store ({size; _}, e1, e2) -> let v1 = unary (eval_expr c e1) e1.at in let v2 = unary (eval_expr c e2) e2.at in - (try Memory.store c.modul.memory (Memory.address_of_value v1) mem v2 + (try Memory.store c.modul.memory (Memory.address_of_value v1) size v2 with exn -> memory_error e.at exn); [] diff --git a/ml-proto/src/lexer.mll b/ml-proto/src/lexer.mll index 61dd4149ae..e35199a4ca 100644 --- a/ml-proto/src/lexer.mll +++ b/ml-proto/src/lexer.mll @@ -60,25 +60,11 @@ let floatop t f32 f64 = | "f64" -> Values.Float64 f64 | _ -> assert false -let mem_type t sign memty = - let open Memory in - match t, sign, memty with - | ("i32" | "i64"), 's', "i8" -> SInt8Mem - | ("i32" | "i64"), 's', "i16" -> SInt16Mem - | ("i32" | "i64"), 's', "i32" -> SInt32Mem - | "i64", 's', "i64" -> SInt64Mem - | ("i32" | "i64"), 'u', "i8" -> UInt8Mem - | ("i32" | "i64"), 'u', "i16" -> UInt16Mem - | ("i32" | "i64"), 'u', "i32" -> UInt32Mem - | "i64", 'u', "i64" -> UInt64Mem - | "f32", ' ', "f32" -> Float32Mem - | "f64", ' ', "f64" -> Float64Mem - | _ -> assert false - let memop ty sign memsize a = - let memty = mem_type ty sign memsize in - let align = if a = "" then Memory.mem_size memty else int_of_string a in - {ty = value_type ty; mem = memty; align} + let size = int_of_string memsize in + let align = if a = "" then size else int_of_string a in + let signed = if sign = ' ' then None else Some (sign = 's') in + {ty = value_type ty; size; align; signed} } @@ -91,6 +77,7 @@ let tick = '\'' let escape = ['n''t''\\''\'''\"'] let character = [^'"''\\''\n'] | '\\'escape | '\\'hexdigit hexdigit +let nat = digit+ let num = ('+' | '-')? digit+ let int = num let float = (num '.' digit+) | num ('.' digit+)? ('e' | 'E') num @@ -100,10 +87,8 @@ let name = '$' (letter | digit | '_' | tick | symbol)+ let ixx = "i" ("32" | "64") let fxx = "f" ("32" | "64") let nxx = ixx | fxx -let mixx = "i" ("8" | "16" | "32" | "64") -let mfxx = "f" ("32" | "64") +let size = "8" | "16" | "32" | "64" let sign = "s" | "u" -let align = digit+ rule token = parse | "(" { LPAR } @@ -139,17 +124,13 @@ rule token = parse | "load_global" { LOADGLOBAL } | "store_global" { STOREGLOBAL } - | (ixx as t)".load_"(sign as s)"/"(mixx as m)"/"(align as a) + | (ixx as t)".load"(size as m)"_"(sign as s)"/"(nat as a) { LOAD (memop t s m a) } - | (ixx as t)".load_"(sign as s)"/"(mixx as m) { LOAD (memop t s m "") } - | (ixx as t)".load/"(mixx as m)"/"(align as a) { LOAD (memop t 's' m a) } - | (ixx as t)".load/"(mixx as m) { LOAD (memop t 's' m "") } - | (ixx as t)".store/"(mixx as m)"/"(align as a) { STORE (memop t 's' m a) } - | (ixx as t)".store/"(mixx as m) { STORE (memop t 's' m "") } - | (fxx as t)".load/"(mfxx as m)"/"(align as a) { LOAD (memop t ' ' m a) } - | (fxx as t)".store/"(mfxx as m)"/"(align as a) { STORE (memop t ' ' m a) } - | (fxx as t)".load/"(mfxx as m) { LOAD (memop t ' ' m "") } - | (fxx as t)".store/"(mfxx as m) { STORE (memop t ' ' m "") } + | (ixx as t)".load"(size as m)"_"(sign as s) { LOAD (memop t s m "") } + | (nxx as t)".load"(size as m)"/"(nat as a) { LOAD (memop t ' ' m a) } + | (nxx as t)".load"(size as m) { LOAD (memop t ' ' m "") } + | (nxx as t)".store"(size as m)"/"(nat as a) { STORE (memop t ' ' m a) } + | (nxx as t)".store"(size as m) { STORE (memop t ' ' m "") } | (nxx as t)".switch" { SWITCH (value_type t) } | (nxx as t)".const" { CONST (value_type t) } diff --git a/ml-proto/src/memory.ml b/ml-proto/src/memory.ml index 214df3d95b..575c3e851e 100644 --- a/ml-proto/src/memory.ml +++ b/ml-proto/src/memory.ml @@ -9,11 +9,7 @@ open Bigarray type address = int type size = address -type mem_size = int -type mem_type = - | SInt8Mem | SInt16Mem | SInt32Mem | SInt64Mem - | UInt8Mem | UInt16Mem | UInt32Mem | UInt64Mem - | Float32Mem | Float64Mem +type signed = bool option type segment = { @@ -26,28 +22,17 @@ type t = memory type char_view = (char, int8_unsigned_elt, c_layout) Array1.t type sint8_view = (int, int8_signed_elt, c_layout) Array1.t -type sint16_view = (int, int16_signed_elt, c_layout) Array1.t -type sint32_view = (int32, int32_elt, c_layout) Array1.t -type sint64_view = (int64, int64_elt, c_layout) Array1.t type uint8_view = (int, int8_unsigned_elt, c_layout) Array1.t +type sint16_view = (int, int16_signed_elt, c_layout) Array1.t type uint16_view = (int, int16_unsigned_elt, c_layout) Array1.t -type uint32_view = (int32, int32_elt, c_layout) Array1.t -type uint64_view = (int64, int64_elt, c_layout) Array1.t +type int32_view = (int32, int32_elt, c_layout) Array1.t +type int64_view = (int64, int64_elt, c_layout) Array1.t type float32_view = (float, float32_elt, c_layout) Array1.t type float64_view = (float, float64_elt, c_layout) Array1.t let view : memory -> ('c, 'd, c_layout) Array1.t = Obj.magic -(* Queries *) - -let mem_size = function - | SInt8Mem | UInt8Mem -> 1 - | SInt16Mem | UInt16Mem -> 2 - | SInt32Mem | UInt32Mem | Float32Mem -> 4 - | SInt64Mem | UInt64Mem | Float64Mem -> 8 - - (* Creation and initialization *) exception Type @@ -83,53 +68,52 @@ let int64_of_int32_u i = Int64.logand (Int64.of_int32 i) int32_mask let buf = create 8 -let load mem a memty valty = - let sz = mem_size memty in - let open Types in +let load mem a sz t signed = try - Array1.blit (Array1.sub mem a sz) (Array1.sub buf 0 sz); - match memty, valty with - | SInt8Mem, Int32Type -> Int32 (Int32.of_int (view buf : sint8_view).{0}) - | SInt8Mem, Int64Type -> Int64 (Int64.of_int (view buf : sint8_view).{0}) - | SInt16Mem, Int32Type -> Int32 (Int32.of_int (view buf : sint16_view).{0}) - | SInt16Mem, Int64Type -> Int64 (Int64.of_int (view buf : sint16_view).{0}) - | SInt32Mem, Int32Type -> Int32 (view buf : sint32_view).{0} - | SInt32Mem, Int64Type -> - Int64 (Int64.of_int32 (view buf : sint32_view).{0}) - | SInt64Mem, Int64Type -> Int64 (view buf : sint64_view).{0} - | UInt8Mem, Int32Type -> Int32 (Int32.of_int (view buf : uint8_view).{0}) - | UInt8Mem, Int64Type -> Int64 (Int64.of_int (view buf : uint8_view).{0}) - | UInt16Mem, Int32Type -> Int32 (Int32.of_int (view buf : uint16_view).{0}) - | UInt16Mem, Int64Type -> Int64 (Int64.of_int (view buf : uint16_view).{0}) - | UInt32Mem, Int32Type -> Int32 (view buf : uint32_view).{0} - | UInt32Mem, Int64Type -> - Int64 (int64_of_int32_u (view buf : uint32_view).{0}) - | UInt64Mem, Int64Type -> Int64 (view buf : uint64_view).{0} - | Float32Mem, Float32Type -> Float32 (view buf : float32_view).{0} - | Float64Mem, Float64Type -> Float64 (view buf : float64_view).{0} + Array1.blit (Array1.sub mem a (sz/8)) (Array1.sub buf 0 (sz/8)); + let open Types in + match t, sz, signed with + | Int32Type, 8, Some true -> + Int32 (Int32.of_int (view buf : sint8_view).{0}) + | Int32Type, 8, Some false -> + Int32 (Int32.of_int (view buf : uint8_view).{0}) + | Int32Type, 16, Some true -> + Int32 (Int32.of_int (view buf : sint16_view).{0}) + | Int32Type, 16, Some false -> + Int32 (Int32.of_int (view buf : uint16_view).{0}) + | Int32Type, 32, None -> + Int32 (view buf : int32_view).{0} + | Int64Type, 8, Some true -> + Int64 (Int64.of_int (view buf : sint8_view).{0}) + | Int64Type, 8, Some false -> + Int64 (Int64.of_int (view buf : uint8_view).{0}) + | Int64Type, 16, Some true -> + Int64 (Int64.of_int (view buf : sint16_view).{0}) + | Int64Type, 16, Some false -> + Int64 (Int64.of_int (view buf : uint16_view).{0}) + | Int64Type, 32, Some true -> + Int64 (Int64.of_int32 (view buf : int32_view).{0}) + | Int64Type, 32, Some false -> + Int64 (int64_of_int32_u (view buf : int32_view).{0}) + | Int64Type, 64, None -> + Int64 (view buf : int64_view).{0} + | Float32Type, 32, None -> Float32 (view buf : float32_view).{0} + | Float64Type, 64, None -> Float64 (view buf : float64_view).{0} | _ -> raise Type with Invalid_argument _ -> raise Bounds -let store mem a memty v = - let sz = mem_size memty in +let store mem a sz v = try - (match memty, v with - | SInt8Mem, Int32 x -> (view buf : sint8_view).{0} <- Int32.to_int x - | SInt8Mem, Int64 x -> (view buf : sint8_view).{0} <- Int64.to_int x - | SInt16Mem, Int32 x -> (view buf : sint16_view).{0} <- Int32.to_int x - | SInt16Mem, Int64 x -> (view buf : sint16_view).{0} <- Int64.to_int x - | SInt32Mem, Int32 x -> (view buf : sint32_view).{0} <- x - | SInt32Mem, Int64 x -> (view buf : sint32_view).{0} <- Int64.to_int32 x - | SInt64Mem, Int64 x -> (view buf : sint64_view).{0} <- x - | UInt8Mem, Int32 x -> (view buf : uint8_view).{0} <- Int32.to_int x - | UInt8Mem, Int64 x -> (view buf : uint8_view).{0} <- Int64.to_int x - | UInt16Mem, Int32 x -> (view buf : uint16_view).{0} <- Int32.to_int x - | UInt16Mem, Int64 x -> (view buf : uint16_view).{0} <- Int64.to_int x - | UInt32Mem, Int32 x -> (view buf : uint32_view).{0} <- x - | UInt32Mem, Int64 x -> (view buf : uint32_view).{0} <- Int64.to_int32 x - | UInt64Mem, Int64 x -> (view buf : uint64_view).{0} <- x - | Float32Mem, Float32 x -> (view buf : float32_view).{0} <- x - | Float64Mem, Float64 x -> (view buf : float64_view).{0} <- x + (match v, sz with + | Int32 x, 8 -> (view buf : sint8_view).{0} <- Int32.to_int x + | Int64 x, 8 -> (view buf : sint8_view).{0} <- Int64.to_int x + | Int32 x, 16 -> (view buf : sint16_view).{0} <- Int32.to_int x + | Int64 x, 16 -> (view buf : sint16_view).{0} <- Int64.to_int x + | Int32 x, 32 -> (view buf : int32_view).{0} <- x + | Int64 x, 32 -> (view buf : int32_view).{0} <- Int64.to_int32 x + | Int64 x, 64 -> (view buf : int64_view).{0} <- x + | Float32 x, 32 -> (view buf : float32_view).{0} <- x + | Float64 x, 64 -> (view buf : float64_view).{0} <- x | _ -> raise Type); - Array1.blit (Array1.sub buf 0 sz) (Array1.sub mem a sz) + Array1.blit (Array1.sub buf 0 (sz/8)) (Array1.sub mem a (sz/8)) with Invalid_argument _ -> raise Bounds diff --git a/ml-proto/src/memory.mli b/ml-proto/src/memory.mli index d0f826cf53..eb9f9fa885 100644 --- a/ml-proto/src/memory.mli +++ b/ml-proto/src/memory.mli @@ -6,11 +6,7 @@ type memory type t = memory type address = int type size = address -type mem_size = int -type mem_type = - | SInt8Mem | SInt16Mem | SInt32Mem | SInt64Mem - | UInt8Mem | UInt16Mem | UInt32Mem | UInt64Mem - | Float32Mem | Float64Mem +type signed = bool option type segment = {addr : address; data : string} @@ -20,8 +16,7 @@ exception Address val create : size -> memory val init : memory -> segment list -> unit -val load : memory -> address -> mem_type -> Types.value_type -> Values.value -val store : memory -> address -> mem_type -> Values.value -> unit +val load : memory -> address -> size -> Types.value_type -> signed -> Values.value +val store : memory -> address -> size -> Values.value -> unit -val mem_size : mem_type -> mem_size val address_of_value : Values.value -> address diff --git a/ml-proto/test/memory.wasm b/ml-proto/test/memory.wasm index ee14bedb82..f8e349a34f 100644 --- a/ml-proto/test/memory.wasm +++ b/ml-proto/test/memory.wasm @@ -35,29 +35,29 @@ ) ;; Test alignment annotation rules -(module (func (i32.load_u/i8/2 (i32.const 0)))) -(module (func (i32.load_u/i16/4 (i32.const 0)))) -(module (func (i32.load_u/i32/8 (i32.const 0)))) -(module (func (f32.load/f32/8 (i32.const 0)))) +(module (func (i32.load8_u/2 (i32.const 0)))) +(module (func (i32.load16_u/4 (i32.const 0)))) +(module (func (i32.load32/8 (i32.const 0)))) +(module (func (f32.load32/8 (i32.const 0)))) (assert_invalid - (module (func (i64.load_u/i64/0 (i32.const 0)))) + (module (func (i64.load64_u/0 (i32.const 0)))) "non-power-of-two alignment" ) (assert_invalid - (module (func (i64.load_u/i64/3 (i32.const 0)))) + (module (func (i64.load64_u/3 (i32.const 0)))) "non-power-of-two alignment" ) (assert_invalid - (module (func (i64.load_u/i64/5 (i32.const 0)))) + (module (func (i64.load64_u/5 (i32.const 0)))) "non-power-of-two alignment" ) (assert_invalid - (module (func (i64.load_u/i64/6 (i32.const 0)))) + (module (func (i64.load64_u/6 (i32.const 0)))) "non-power-of-two alignment" ) (assert_invalid - (module (func (i64.load_u/i64/7 (i32.const 0)))) + (module (func (i64.load64_u/7 (i32.const 0)))) "non-power-of-two alignment" ) @@ -68,12 +68,12 @@ (func $data (result i32) (i32.and (i32.and - (i32.eq (i32.load_u/i8 (i32.const 0)) (i32.const 65)) - (i32.eq (i32.load_u/i8 (i32.const 3)) (i32.const 167)) + (i32.eq (i32.load8_u (i32.const 0)) (i32.const 65)) + (i32.eq (i32.load8_u (i32.const 3)) (i32.const 167)) ) (i32.and - (i32.eq (i32.load_u/i8 (i32.const 20)) (i32.const 87)) - (i32.eq (i32.load_u/i8 (i32.const 23)) (i32.const 77)) + (i32.eq (i32.load8_u (i32.const 20)) (i32.const 87)) + (i32.eq (i32.load8_u (i32.const 23)) (i32.const 77)) ) ) ) @@ -89,8 +89,8 @@ (break) ) (set_local 2 (i32.mul (get_local 0) (i32.const 4))) - (i32.store/i32 (get_local 2) (get_local 0)) - (set_local 1 (i32.load_s/i32 (get_local 2))) + (i32.store32 (get_local 2) (get_local 0)) + (set_local 1 (i32.load32 (get_local 2))) (if (i32.neq (get_local 0) (get_local 1)) (return (i32.const 0)) @@ -112,8 +112,8 @@ (break) ) (set_local 2 (f64.convert_s/i32 (get_local 0))) - (f64.store/f64/1 (get_local 0) (get_local 2)) - (set_local 1 (f64.load/f64/1 (get_local 0))) + (f64.store64/1 (get_local 0) (get_local 2)) + (set_local 1 (f64.load64/1 (get_local 0))) (if (f64.neq (get_local 2) (get_local 1)) (return (i32.const 0)) @@ -126,17 +126,17 @@ ;; Memory cast (func $cast (result f64) - (i64.store/i64 (i32.const 8) (i64.const -12345)) + (i64.store64 (i32.const 8) (i64.const -12345)) (if (f64.eq - (f64.load/f64 (i32.const 8)) + (f64.load64 (i32.const 8)) (f64.reinterpret/i64 (i64.const -12345)) ) (return (f64.const 0)) ) - (i64.store/i64/1 (i32.const 9) (i64.const 0)) - (i32.store/i16/1 (i32.const 15) (i32.const 16453)) - (return (f64.load/f64/1 (i32.const 9))) + (i64.store64/1 (i32.const 9) (i64.const 0)) + (i32.store16/1 (i32.const 15) (i32.const 16453)) + (return (f64.load64/1 (i32.const 9))) ) (export "data" $data)