From b01e824708ed409128f2a94d6952e2b8421a20b9 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Wed, 28 Feb 2018 13:17:41 +0100 Subject: [PATCH 1/8] [interpreter] Implement reference types and multiple tables --- interpreter/binary/decode.ml | 25 +++-- interpreter/binary/encode.ml | 18 +++- interpreter/exec/eval.ml | 102 +++++++++++---------- interpreter/exec/eval_numeric.ml | 146 ++++++++++++++++++------------ interpreter/exec/eval_numeric.mli | 12 +-- interpreter/host/env.ml | 6 +- interpreter/host/spectest.ml | 28 +++--- interpreter/runtime/global.ml | 13 ++- interpreter/runtime/instance.ml | 17 +++- interpreter/runtime/memory.ml | 22 ++--- interpreter/runtime/memory.mli | 12 +-- interpreter/runtime/table.ml | 20 ++-- interpreter/runtime/table.mli | 11 +-- interpreter/script/js.ml | 43 +++++---- interpreter/script/run.ml | 16 ++-- interpreter/syntax/ast.ml | 9 +- interpreter/syntax/operators.ml | 5 +- interpreter/syntax/types.ml | 38 ++++++-- interpreter/syntax/values.ml | 79 +++++++--------- interpreter/text/arrange.ml | 22 +++-- interpreter/text/lexer.mll | 14 ++- interpreter/text/parser.mly | 58 +++++++----- interpreter/valid/valid.ml | 94 ++++++++++++------- test/core/binary.wast | 19 ---- test/core/imports.wast | 13 --- 25 files changed, 479 insertions(+), 363 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 68a8d9c4..11c52151 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -131,18 +131,25 @@ let sized f s = open Types -let value_type s = +let num_type s = match vs7 s with | -0x01 -> I32Type | -0x02 -> I64Type | -0x03 -> F32Type | -0x04 -> F64Type - | _ -> error s (pos s - 1) "invalid value type" + | _ -> error s (pos s - 1) "invalid number type" -let elem_type s = +let ref_type s = match vs7 s with | -0x10 -> AnyFuncType - | _ -> error s (pos s - 1) "invalid element type" + | -0x11 -> AnyRefType + | -0x12 -> NullRefType + | _ -> error s (pos s - 1) "invalid reference type" + +let value_type s = + match peek s with + | Some n when n > 0x70 -> NumType (num_type s) + | _ -> RefType (ref_type s) let stack_type s = match peek s with @@ -164,7 +171,7 @@ let limits vu s = {min; max} let table_type s = - let t = elem_type s in + let t = ref_type s in let lim = limits vu32 s in TableType (lim, t) @@ -243,9 +250,9 @@ let rec instr s = | 0x10 -> call (at var s) | 0x11 -> + let y = at var s in let x = at var s in - expect 0x00 s "zero flag expected"; - call_indirect x + call_indirect x y | 0x12 | 0x13 | 0x14 | 0x15 | 0x16 | 0x17 | 0x18 | 0x19 as b -> illegal s pos b @@ -259,8 +266,10 @@ let rec instr s = | 0x22 -> tee_local (at var s) | 0x23 -> get_global (at var s) | 0x24 -> set_global (at var s) + | 0x25 -> get_table (at var s) + | 0x26 -> set_table (at var s) - | 0x25 | 0x26 | 0x27 as b -> illegal s pos b + | 0x27 -> ref_null | 0x28 -> let a, o = memop s in i32_load a o | 0x29 -> let a, o = memop s in i64_load a o diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index adbf418a..2ee80656 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -90,14 +90,20 @@ let encode m = open Types - let value_type = function + let num_type = function | I32Type -> vs7 (-0x01) | I64Type -> vs7 (-0x02) | F32Type -> vs7 (-0x03) | F64Type -> vs7 (-0x04) - let elem_type = function + let ref_type = function | AnyFuncType -> vs7 (-0x10) + | AnyRefType -> vs7 (-0x11) + | NullRefType -> vs7 (-0x12) + + let value_type = function + | NumType t -> num_type t + | RefType t -> ref_type t let stack_type = function | [] -> vs7 (-0x40) @@ -113,7 +119,7 @@ let encode m = bool (max <> None); vu min; opt vu max let table_type = function - | TableType (lim, t) -> elem_type t; limits vu32 lim + | TableType (lim, t) -> ref_type t; limits vu32 lim let memory_type = function | MemoryType lim -> limits vu32 lim @@ -156,7 +162,7 @@ let encode m = | BrTable (xs, x) -> op 0x0e; vec var xs; var x | Return -> op 0x0f | Call x -> op 0x10; var x - | CallIndirect x -> op 0x11; var x; u8 0x00 + | CallIndirect (x, y) -> op 0x11; var y; var x | Drop -> op 0x1a | Select -> op 0x1b @@ -166,6 +172,10 @@ let encode m = | TeeLocal x -> op 0x22; var x | GetGlobal x -> op 0x23; var x | SetGlobal x -> op 0x24; var x + | GetTable x -> op 0x25; var x + | SetTable x -> op 0x26; var x + + | Null -> op 0x27 | Load ({ty = I32Type; sz = None; _} as mo) -> op 0x28; memop mo | Load ({ty = I64Type; sz = None; _} as mo) -> op 0x29; memop mo diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index a6bc8f39..bf6f2d0e 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -30,8 +30,8 @@ let numeric_error at = function | Numeric_error.InvalidConversionToInteger -> "invalid conversion to integer" | Eval_numeric.TypeError (i, v, t) -> Crash.error at - ("type error, expected " ^ Types.string_of_value_type t ^ " as operand " ^ - string_of_int i ^ ", got " ^ Types.string_of_value_type (type_of v)) + ("type error, expected " ^ Types.string_of_num_type t ^ " as operand " ^ + string_of_int i ^ ", got " ^ Types.string_of_num_type (type_of_num v)) | exn -> raise exn @@ -80,17 +80,14 @@ let memory (inst : module_inst) x = lookup "memory" inst.memories x let global (inst : module_inst) x = lookup "global" inst.globals x let local (frame : frame) x = lookup "local" frame.locals x -let elem inst x i at = - match Table.load (table inst x) i with - | Table.Uninitialized -> - Trap.error at ("uninitialized element " ^ Int32.to_string i) - | f -> f - | exception Table.Bounds -> +let any_ref inst x i at = + try Table.load (table inst x) i with Table.Bounds -> Trap.error at ("undefined element " ^ Int32.to_string i) -let func_elem inst x i at = - match elem inst x i at with - | FuncElem f -> f +let func_ref inst x i at = + match any_ref inst x i at with + | FuncRef f -> f + | NullRef -> Trap.error at ("uninitialized element " ^ Int32.to_string i) | _ -> Crash.error at ("type mismatch for element " ^ Int32.to_string i) let take n (vs : 'a stack) at = @@ -130,25 +127,26 @@ let rec step (c : config) : config = | Loop (ts, es'), vs -> vs, [Label (0, [e' @@ e.at], ([], List.map plain es')) @@ e.at] - | If (ts, es1, es2), I32 0l :: vs' -> + | If (ts, es1, es2), Num (I32 0l) :: vs' -> vs', [Plain (Block (ts, es2)) @@ e.at] - | If (ts, es1, es2), I32 i :: vs' -> + | If (ts, es1, es2), Num (I32 i) :: vs' -> vs', [Plain (Block (ts, es1)) @@ e.at] | Br x, vs -> [], [Breaking (x.it, vs) @@ e.at] - | BrIf x, I32 0l :: vs' -> + | BrIf x, Num (I32 0l) :: vs' -> vs', [] - | BrIf x, I32 i :: vs' -> + | BrIf x, Num (I32 i) :: vs' -> vs', [Plain (Br x) @@ e.at] - | BrTable (xs, x), I32 i :: vs' when I32.ge_u i (Lib.List32.length xs) -> + | BrTable (xs, x), Num (I32 i) :: vs' + when I32.ge_u i (Lib.List32.length xs) -> vs', [Plain (Br x) @@ e.at] - | BrTable (xs, x), I32 i :: vs' -> + | BrTable (xs, x), Num (I32 i) :: vs' -> vs', [Plain (Br (Lib.List32.nth xs i)) @@ e.at] | Return, vs -> @@ -157,9 +155,9 @@ let rec step (c : config) : config = | Call x, vs -> vs, [Invoke (func frame.inst x) @@ e.at] - | CallIndirect x, I32 i :: vs -> - let func = func_elem frame.inst (0l @@ e.at) i e.at in - if type_ frame.inst x <> Func.type_of func then + | CallIndirect (x, y), Num (I32 i) :: vs -> + let func = func_ref frame.inst x i e.at in + if type_ frame.inst y <> Func.type_of func then vs, [Trapping "indirect call type mismatch" @@ e.at] else vs, [Invoke func @@ e.at] @@ -167,10 +165,10 @@ let rec step (c : config) : config = | Drop, v :: vs' -> vs', [] - | Select, I32 0l :: v2 :: v1 :: vs' -> + | Select, Num (I32 0l) :: v2 :: v1 :: vs' -> v2 :: vs', [] - | Select, I32 i :: v2 :: v1 :: vs' -> + | Select, Num (I32 i) :: v2 :: v1 :: vs' -> v1 :: vs', [] | GetLocal x, vs -> @@ -192,66 +190,76 @@ let rec step (c : config) : config = with Global.NotMutable -> Crash.error e.at "write to immutable global" | Global.Type -> Crash.error e.at "type mismatch at global write") - | Load {offset; ty; sz; _}, I32 i :: vs' -> + | GetTable x, Num (I32 i) :: vs -> + Ref (Table.load (table frame.inst x) i) :: vs, [] + + | SetTable x, Ref r :: Num (I32 i) :: vs' -> + (try Table.store (table frame.inst x) i r; vs', [] + with Table.Type -> Crash.error e.at "type mismatch at table write") + + | Load {offset; ty; sz; _}, Num (I32 i) :: vs' -> let mem = memory frame.inst (0l @@ e.at) in let addr = I64_convert.extend_u_i32 i in (try - let v = + let n = match sz with - | None -> Memory.load_value mem addr offset ty + | None -> Memory.load_num mem addr offset ty | Some (sz, ext) -> Memory.load_packed sz ext mem addr offset ty - in v :: vs', [] + in Num n :: vs', [] with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at]) - | Store {offset; sz; _}, v :: I32 i :: vs' -> + | Store {offset; sz; _}, Num n :: Num (I32 i) :: vs' -> let mem = memory frame.inst (0l @@ e.at) in let addr = I64_convert.extend_u_i32 i in (try (match sz with - | None -> Memory.store_value mem addr offset v - | Some sz -> Memory.store_packed sz mem addr offset v + | None -> Memory.store_num mem addr offset n + | Some sz -> Memory.store_packed sz mem addr offset n ); vs', [] with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at]); | CurrentMemory, vs -> let mem = memory frame.inst (0l @@ e.at) in - I32 (Memory.size mem) :: vs, [] + Num (I32 (Memory.size mem)) :: vs, [] - | GrowMemory, I32 delta :: vs' -> + | GrowMemory, Num (I32 delta) :: vs' -> let mem = memory frame.inst (0l @@ e.at) in let old_size = Memory.size mem in let result = try Memory.grow mem delta; old_size with Memory.SizeOverflow | Memory.SizeLimit | Memory.OutOfMemory -> -1l - in I32 result :: vs', [] + in Num (I32 result) :: vs', [] + + | Null, vs -> + Ref NullRef :: vs, [] - | Const v, vs -> - v.it :: vs, [] + | Const n, vs -> + Num n.it :: vs, [] - | Test testop, v :: vs' -> - (try value_of_bool (Eval_numeric.eval_testop testop v) :: vs', [] + | Test testop, Num n :: vs' -> + (try value_of_bool (Eval_numeric.eval_testop testop n) :: vs', [] with exn -> vs', [Trapping (numeric_error e.at exn) @@ e.at]) - | Compare relop, v2 :: v1 :: vs' -> - (try value_of_bool (Eval_numeric.eval_relop relop v1 v2) :: vs', [] + | Compare relop, Num n2 :: Num n1 :: vs' -> + (try value_of_bool (Eval_numeric.eval_relop relop n1 n2) :: vs', [] with exn -> vs', [Trapping (numeric_error e.at exn) @@ e.at]) - | Unary unop, v :: vs' -> - (try Eval_numeric.eval_unop unop v :: vs', [] + | Unary unop, Num n :: vs' -> + (try Num (Eval_numeric.eval_unop unop n) :: vs', [] with exn -> vs', [Trapping (numeric_error e.at exn) @@ e.at]) - | Binary binop, v2 :: v1 :: vs' -> - (try Eval_numeric.eval_binop binop v1 v2 :: vs', [] + | Binary binop, Num n2 :: Num n1 :: vs' -> + (try Num (Eval_numeric.eval_binop binop n1 n2) :: vs', [] with exn -> vs', [Trapping (numeric_error e.at exn) @@ e.at]) - | Convert cvtop, v :: vs' -> - (try Eval_numeric.eval_cvtop cvtop v :: vs', [] + | Convert cvtop, Num n :: vs' -> + (try Num (Eval_numeric.eval_cvtop cvtop n) :: vs', [] with exn -> vs', [Trapping (numeric_error e.at exn) @@ e.at]) | _ -> let s1 = string_of_values (List.rev vs) in - let s2 = string_of_value_types (List.map type_of (List.rev vs)) in + let s2 = string_of_value_types (List.map type_of_value (List.rev vs)) in Crash.error e.at ("missing or ill-typed operand on stack (" ^ s1 ^ " : " ^ s2 ^ ")") ) @@ -349,7 +357,7 @@ let eval_const (inst : module_inst) (const : const) : value = let i32 (v : value) at = match v with - | I32 i -> i + | Num (I32 i) -> i | _ -> Crash.error at "type error: i32 value expected" @@ -396,7 +404,7 @@ let init_table (inst : module_inst) (seg : table_segment) = if I32.lt_u bound end_ || I32.lt_u end_ offset then Link.error seg.at "elements segment does not fit table"; fun () -> - Table.blit tab offset (List.map (fun x -> FuncElem (func inst x)) init) + Table.blit tab offset (List.map (fun x -> FuncRef (func inst x)) init) let init_memory (inst : module_inst) (seg : memory_segment) = let {index; offset = const; init} = seg.it in diff --git a/interpreter/exec/eval_numeric.ml b/interpreter/exec/eval_numeric.ml index dd402558..7a84a2ca 100644 --- a/interpreter/exec/eval_numeric.ml +++ b/interpreter/exec/eval_numeric.ml @@ -2,29 +2,59 @@ open Types open Values -(* Runtime type errors *) +(* Injection & projection *) -exception TypeError of int * value * value_type +exception TypeError of int * num * num_type -let of_arg f n v = - try f v with Value t -> raise (TypeError (n, v, t)) +module type NumType = +sig + type t + val to_num : t -> num + val of_num : int -> num -> t +end + +module I32Num = +struct + type t = I32.t + let to_num i = I32 i + let of_num n = function I32 i -> i | v -> raise (TypeError (n, v, I32Type)) +end + +module I64Num = +struct + type t = I64.t + let to_num i = I64 i + let of_num n = function I64 i -> i | v -> raise (TypeError (n, v, I64Type)) +end + +module F32Num = +struct + type t = F32.t + let to_num i = F32 i + let of_num n = function F32 z -> z | v -> raise (TypeError (n, v, F32Type)) +end + +module F64Num = +struct + type t = F64.t + let to_num i = F64 i + let of_num n = function F64 z -> z | v -> raise (TypeError (n, v, F64Type)) +end (* Int operators *) -module IntOp (IXX : Int.S) (Value : ValueType with type t = IXX.t) = +module IntOp (IXX : Int.S) (Num : NumType with type t = IXX.t) = struct open Ast.IntOp - - let to_value = Value.to_value - let of_value = of_arg Value.of_value + open Num let unop op = let f = match op with | Clz -> IXX.clz | Ctz -> IXX.ctz | Popcnt -> IXX.popcnt - in fun v -> to_value (f (of_value 1 v)) + in fun v -> to_num (f (of_num 1 v)) let binop op = let f = match op with @@ -43,12 +73,12 @@ struct | ShrS -> IXX.shr_s | Rotl -> IXX.rotl | Rotr -> IXX.rotr - in fun v1 v2 -> to_value (f (of_value 1 v1) (of_value 2 v2)) + in fun v1 v2 -> to_num (f (of_num 1 v1) (of_num 2 v2)) let testop op = let f = match op with | Eqz -> IXX.eqz - in fun v -> f (of_value 1 v) + in fun v -> f (of_num 1 v) let relop op = let f = match op with @@ -62,21 +92,19 @@ struct | GtU -> IXX.gt_u | GeS -> IXX.ge_s | GeU -> IXX.ge_u - in fun v1 v2 -> f (of_value 1 v1) (of_value 2 v2) + in fun v1 v2 -> f (of_num 1 v1) (of_num 2 v2) end -module I32Op = IntOp (I32) (Values.I32Value) -module I64Op = IntOp (I64) (Values.I64Value) +module I32Op = IntOp (I32) (I32Num) +module I64Op = IntOp (I64) (I64Num) (* Float operators *) -module FloatOp (FXX : Float.S) (Value : ValueType with type t = FXX.t) = +module FloatOp (FXX : Float.S) (Num : NumType with type t = FXX.t) = struct open Ast.FloatOp - - let to_value = Value.to_value - let of_value = of_arg Value.of_value + open Num let unop op = let f = match op with @@ -87,7 +115,7 @@ struct | Floor -> FXX.floor | Trunc -> FXX.trunc | Nearest -> FXX.nearest - in fun v -> to_value (f (of_value 1 v)) + in fun v -> to_num (f (of_num 1 v)) let binop op = let f = match op with @@ -98,7 +126,7 @@ struct | Min -> FXX.min | Max -> FXX.max | CopySign -> FXX.copysign - in fun v1 v2 -> to_value (f (of_value 1 v1) (of_value 2 v2)) + in fun v1 v2 -> to_num (f (of_num 1 v1) (of_num 2 v2)) let testop op = assert false @@ -110,11 +138,11 @@ struct | Le -> FXX.le | Gt -> FXX.gt | Ge -> FXX.ge - in fun v1 v2 -> f (of_value 1 v1) (of_value 2 v2) + in fun v1 v2 -> f (of_num 1 v1) (of_num 2 v2) end -module F32Op = FloatOp (F32) (Values.F32Value) -module F64Op = FloatOp (F64) (Values.F64Value) +module F32Op = FloatOp (F32) (F32Num) +module F64Op = FloatOp (F64) (F64Num) (* Conversion operators *) @@ -124,15 +152,16 @@ struct open Ast.IntOp let cvtop op v = - match op with - | WrapI64 -> I32 (I32_convert.wrap_i64 (I64Op.of_value 1 v)) - | TruncSF32 -> I32 (I32_convert.trunc_s_f32 (F32Op.of_value 1 v)) - | TruncUF32 -> I32 (I32_convert.trunc_u_f32 (F32Op.of_value 1 v)) - | TruncSF64 -> I32 (I32_convert.trunc_s_f64 (F64Op.of_value 1 v)) - | TruncUF64 -> I32 (I32_convert.trunc_u_f64 (F64Op.of_value 1 v)) - | ReinterpretFloat -> I32 (I32_convert.reinterpret_f32 (F32Op.of_value 1 v)) - | ExtendSI32 -> raise (TypeError (1, v, I32Type)) - | ExtendUI32 -> raise (TypeError (1, v, I32Type)) + let i = match op with + | WrapI64 -> I32_convert.wrap_i64 (I64Num.of_num 1 v) + | TruncSF32 -> I32_convert.trunc_s_f32 (F32Num.of_num 1 v) + | TruncUF32 -> I32_convert.trunc_u_f32 (F32Num.of_num 1 v) + | TruncSF64 -> I32_convert.trunc_s_f64 (F64Num.of_num 1 v) + | TruncUF64 -> I32_convert.trunc_u_f64 (F64Num.of_num 1 v) + | ReinterpretFloat -> I32_convert.reinterpret_f32 (F32Num.of_num 1 v) + | ExtendSI32 -> raise (TypeError (1, v, I32Type)) + | ExtendUI32 -> raise (TypeError (1, v, I32Type)) + in I32Num.to_num i end module I64CvtOp = @@ -140,15 +169,16 @@ struct open Ast.IntOp let cvtop op v = - match op with - | ExtendSI32 -> I64 (I64_convert.extend_s_i32 (I32Op.of_value 1 v)) - | ExtendUI32 -> I64 (I64_convert.extend_u_i32 (I32Op.of_value 1 v)) - | TruncSF32 -> I64 (I64_convert.trunc_s_f32 (F32Op.of_value 1 v)) - | TruncUF32 -> I64 (I64_convert.trunc_u_f32 (F32Op.of_value 1 v)) - | TruncSF64 -> I64 (I64_convert.trunc_s_f64 (F64Op.of_value 1 v)) - | TruncUF64 -> I64 (I64_convert.trunc_u_f64 (F64Op.of_value 1 v)) - | ReinterpretFloat -> I64 (I64_convert.reinterpret_f64 (F64Op.of_value 1 v)) - | WrapI64 -> raise (TypeError (1, v, I64Type)) + let i = match op with + | ExtendSI32 -> I64_convert.extend_s_i32 (I32Num.of_num 1 v) + | ExtendUI32 -> I64_convert.extend_u_i32 (I32Num.of_num 1 v) + | TruncSF32 -> I64_convert.trunc_s_f32 (F32Num.of_num 1 v) + | TruncUF32 -> I64_convert.trunc_u_f32 (F32Num.of_num 1 v) + | TruncSF64 -> I64_convert.trunc_s_f64 (F64Num.of_num 1 v) + | TruncUF64 -> I64_convert.trunc_u_f64 (F64Num.of_num 1 v) + | ReinterpretFloat -> I64_convert.reinterpret_f64 (F64Num.of_num 1 v) + | WrapI64 -> raise (TypeError (1, v, I64Type)) + in I64Num.to_num i end module F32CvtOp = @@ -156,14 +186,15 @@ struct open Ast.FloatOp let cvtop op v = - match op with - | DemoteF64 -> F32 (F32_convert.demote_f64 (F64Op.of_value 1 v)) - | ConvertSI32 -> F32 (F32_convert.convert_s_i32 (I32Op.of_value 1 v)) - | ConvertUI32 -> F32 (F32_convert.convert_u_i32 (I32Op.of_value 1 v)) - | ConvertSI64 -> F32 (F32_convert.convert_s_i64 (I64Op.of_value 1 v)) - | ConvertUI64 -> F32 (F32_convert.convert_u_i64 (I64Op.of_value 1 v)) - | ReinterpretInt -> F32 (F32_convert.reinterpret_i32 (I32Op.of_value 1 v)) - | PromoteF32 -> raise (TypeError (1, v, F32Type)) + let z = match op with + | DemoteF64 -> F32_convert.demote_f64 (F64Num.of_num 1 v) + | ConvertSI32 -> F32_convert.convert_s_i32 (I32Num.of_num 1 v) + | ConvertUI32 -> F32_convert.convert_u_i32 (I32Num.of_num 1 v) + | ConvertSI64 -> F32_convert.convert_s_i64 (I64Num.of_num 1 v) + | ConvertUI64 -> F32_convert.convert_u_i64 (I64Num.of_num 1 v) + | ReinterpretInt -> F32_convert.reinterpret_i32 (I32Num.of_num 1 v) + | PromoteF32 -> raise (TypeError (1, v, F32Type)) + in F32Num.to_num z end module F64CvtOp = @@ -171,14 +202,15 @@ struct open Ast.FloatOp let cvtop op v = - match op with - | PromoteF32 -> F64 (F64_convert.promote_f32 (F32Op.of_value 1 v)) - | ConvertSI32 -> F64 (F64_convert.convert_s_i32 (I32Op.of_value 1 v)) - | ConvertUI32 -> F64 (F64_convert.convert_u_i32 (I32Op.of_value 1 v)) - | ConvertSI64 -> F64 (F64_convert.convert_s_i64 (I64Op.of_value 1 v)) - | ConvertUI64 -> F64 (F64_convert.convert_u_i64 (I64Op.of_value 1 v)) - | ReinterpretInt -> F64 (F64_convert.reinterpret_i64 (I64Op.of_value 1 v)) - | DemoteF64 -> raise (TypeError (1, v, F64Type)) + let z = match op with + | PromoteF32 -> F64_convert.promote_f32 (F32Num.of_num 1 v) + | ConvertSI32 -> F64_convert.convert_s_i32 (I32Num.of_num 1 v) + | ConvertUI32 -> F64_convert.convert_u_i32 (I32Num.of_num 1 v) + | ConvertSI64 -> F64_convert.convert_s_i64 (I64Num.of_num 1 v) + | ConvertUI64 -> F64_convert.convert_u_i64 (I64Num.of_num 1 v) + | ReinterpretInt -> F64_convert.reinterpret_i64 (I64Num.of_num 1 v) + | DemoteF64 -> raise (TypeError (1, v, F64Type)) + in F64Num.to_num z end diff --git a/interpreter/exec/eval_numeric.mli b/interpreter/exec/eval_numeric.mli index 7435b3c6..969e4474 100644 --- a/interpreter/exec/eval_numeric.mli +++ b/interpreter/exec/eval_numeric.mli @@ -1,9 +1,9 @@ open Values -exception TypeError of int * value * Types.value_type +exception TypeError of int * num * Types.num_type -val eval_unop : Ast.unop -> value -> value -val eval_binop : Ast.binop -> value -> value -> value -val eval_testop : Ast.testop -> value -> bool -val eval_relop : Ast.relop -> value -> value -> bool -val eval_cvtop : Ast.cvtop -> value -> value +val eval_unop : Ast.unop -> num -> num +val eval_binop : Ast.binop -> num -> num -> num +val eval_testop : Ast.testop -> num -> bool +val eval_relop : Ast.relop -> num -> num -> bool +val eval_cvtop : Ast.cvtop -> num -> num diff --git a/interpreter/host/env.ml b/interpreter/host/env.ml index a23838c5..58239d10 100644 --- a/interpreter/host/env.ml +++ b/interpreter/host/env.ml @@ -14,7 +14,7 @@ let error msg = raise (Eval.Crash (Source.no_region, msg)) let type_error v t = error ("type error, expected " ^ string_of_value_type t ^ - ", got " ^ string_of_value_type (type_of v)) + ", got " ^ string_of_value_type (type_of_value v)) let empty = function | [] -> () @@ -26,8 +26,8 @@ let single = function | vs -> error "type error, too many arguments" let int = function - | I32 i -> Int32.to_int i - | v -> type_error v I32Type + | Num (I32 i) -> Int32.to_int i + | v -> type_error v (NumType I32Type) let abort vs = diff --git a/interpreter/host/spectest.ml b/interpreter/host/spectest.ml index ae543f91..b7812e99 100644 --- a/interpreter/host/spectest.ml +++ b/interpreter/host/spectest.ml @@ -10,10 +10,11 @@ open Instance let global (GlobalType (t, _) as gt) = let v = match t with - | I32Type -> I32 666l - | I64Type -> I64 666L - | F32Type -> F32 (F32.of_float 666.6) - | F64Type -> F64 (F64.of_float 666.6) + | NumType I32Type -> Num (I32 666l) + | NumType I64Type -> Num (I64 666L) + | NumType F32Type -> Num (F32 (F32.of_float 666.6)) + | NumType F64Type -> Num (F64 (F64.of_float 666.6)) + | RefType _ -> Ref NullRef in Global.alloc gt v let table = Table.alloc (TableType ({min = 10l; max = Some 20l}, AnyFuncType)) @@ -22,7 +23,8 @@ let func f t = Func.alloc_host t (f t) let print_value v = Printf.printf "%s : %s\n" - (Values.string_of_value v) (Types.string_of_value_type (Values.type_of v)) + (Values.string_of_value v) + (Types.string_of_value_type (Values.type_of_value v)) let print (FuncType (_, out)) vs = List.iter print_value vs; @@ -33,16 +35,16 @@ let print (FuncType (_, out)) vs = let lookup name t = match Utf8.encode name, t with | "print", _ -> ExternFunc (func print (FuncType ([], []))) - | "print_i32", _ -> ExternFunc (func print (FuncType ([I32Type], []))) + | "print_i32", _ -> ExternFunc (func print (FuncType ([NumType I32Type], []))) | "print_i32_f32", _ -> - ExternFunc (func print (FuncType ([I32Type; F32Type], []))) + ExternFunc (func print (FuncType ([NumType I32Type; NumType F32Type], []))) | "print_f64_f64", _ -> - ExternFunc (func print (FuncType ([F64Type; F64Type], []))) - | "print_f32", _ -> ExternFunc (func print (FuncType ([F32Type], []))) - | "print_f64", _ -> ExternFunc (func print (FuncType ([F64Type], []))) - | "global_i32", _ -> ExternGlobal (global (GlobalType (I32Type, Immutable))) - | "global_f32", _ -> ExternGlobal (global (GlobalType (F32Type, Immutable))) - | "global_f64", _ -> ExternGlobal (global (GlobalType (F64Type, Immutable))) + ExternFunc (func print (FuncType ([NumType F64Type; NumType F64Type], []))) + | "print_f32", _ -> ExternFunc (func print (FuncType ([NumType F32Type], []))) + | "print_f64", _ -> ExternFunc (func print (FuncType ([NumType F64Type], []))) + | "global_i32", _ -> ExternGlobal (global (GlobalType (NumType I32Type, Immutable))) + | "global_f32", _ -> ExternGlobal (global (GlobalType (NumType F32Type, Immutable))) + | "global_f64", _ -> ExternGlobal (global (GlobalType (NumType F64Type, Immutable))) | "table", _ -> ExternTable table | "memory", _ -> ExternMemory memory | _ -> raise Not_found diff --git a/interpreter/runtime/global.ml b/interpreter/runtime/global.ml index c5375d73..828da61d 100644 --- a/interpreter/runtime/global.ml +++ b/interpreter/runtime/global.ml @@ -1,21 +1,20 @@ open Types open Values -type global = {mutable content : value; mut : mutability} +type global = {mutable content : value; ty : value_type; mut : mutability} type t = global exception Type exception NotMutable -let alloc (GlobalType (t, mut)) v = - if type_of v <> t then raise Type; - {content = v; mut = mut} +let alloc (GlobalType (ty, mut)) v = + if not (match_value_type (type_of_value v) ty) then raise Type; + {content = v; ty; mut} -let type_of glob = - GlobalType (type_of glob.content, glob.mut) +let type_of glob = GlobalType (glob.ty, glob.mut) let load glob = glob.content let store glob v = if glob.mut <> Mutable then raise NotMutable; - if Values.type_of v <> Values.type_of glob.content then raise Type; + if not (match_value_type (type_of_value v) glob.ty) then raise Type; glob.content <- v diff --git a/interpreter/runtime/instance.ml b/interpreter/runtime/instance.ml index 6ac58374..2097f6a4 100644 --- a/interpreter/runtime/instance.ml +++ b/interpreter/runtime/instance.ml @@ -22,7 +22,22 @@ and extern = | ExternMemory of memory_inst | ExternGlobal of global_inst -type Table.elem += FuncElem of func_inst + +(* Reference type extensions *) + +type Values.ref_ += FuncRef of func_inst + +let () = + let type_of_ref' = !Values.type_of_ref' in + Values.type_of_ref' := function + | FuncRef _ -> AnyFuncType + | r -> type_of_ref' r + +let () = + let string_of_ref' = !Values.string_of_ref' in + Values.string_of_ref' := function + | FuncRef _ -> "func" + | r -> string_of_ref' r (* Auxiliary functions *) diff --git a/interpreter/runtime/memory.ml b/interpreter/runtime/memory.ml index fd9783d9..d9c150f4 100644 --- a/interpreter/runtime/memory.ml +++ b/interpreter/runtime/memory.ml @@ -104,7 +104,7 @@ let storen mem a o n x = end in loop (effective_address a o) n x -let load_value mem a o t = +let load_num mem a o t = let n = loadn mem a o (Types.size t) in match t with | I32Type -> I32 (Int64.to_int32 n) @@ -112,14 +112,14 @@ let load_value mem a o t = | F32Type -> F32 (F32.of_bits (Int64.to_int32 n)) | F64Type -> F64 (F64.of_bits n) -let store_value mem a o v = +let store_num mem a o n = let x = - match v with + match n with | I32 x -> Int64.of_int32 x | I64 x -> x | F32 x -> Int64.of_int32 (F32.to_bits x) | F64 x -> F64.to_bits x - in storen mem a o (Types.size (Values.type_of v)) x + in storen mem a o (Types.size (Values.type_of_num n)) x let extend x n = function | ZX -> x @@ -127,19 +127,19 @@ let extend x n = function let load_packed sz ext mem a o t = assert (mem_size sz <= Types.size t); - let n = mem_size sz in - let x = extend (loadn mem a o n) n ext in + let w = mem_size sz in + let x = extend (loadn mem a o w) w ext in match t with | I32Type -> I32 (Int64.to_int32 x) | I64Type -> I64 x | _ -> raise Type -let store_packed sz mem a o v = - assert (mem_size sz <= Types.size (Values.type_of v)); - let n = mem_size sz in +let store_packed sz mem a o n = + assert (mem_size sz <= Types.size (Values.type_of_num n)); + let w = mem_size sz in let x = - match v with + match n with | I32 x -> Int64.of_int32 x | I64 x -> x | _ -> raise Type - in storen mem a o n x + in storen mem a o w x diff --git a/interpreter/runtime/memory.mli b/interpreter/runtime/memory.mli index c5586e7b..0a939014 100644 --- a/interpreter/runtime/memory.mli +++ b/interpreter/runtime/memory.mli @@ -32,13 +32,13 @@ val store_byte : memory -> address -> int -> unit (* raises Bounds *) val load_bytes : memory -> address -> int -> string (* raises Bounds *) val store_bytes : memory -> address -> string -> unit (* raises Bounds *) -val load_value : - memory -> address -> offset -> value_type -> value (* raises Bounds *) -val store_value : - memory -> address -> offset -> value -> unit (* raises Bounds *) +val load_num : + memory -> address -> offset -> num_type -> num (* raises Bounds *) +val store_num : + memory -> address -> offset -> num -> unit (* raises Bounds *) val load_packed : - mem_size -> extension -> memory -> address -> offset -> value_type -> value + mem_size -> extension -> memory -> address -> offset -> num_type -> num (* raises Type, Bounds *) val store_packed : - mem_size -> memory -> address -> offset -> value -> unit + mem_size -> memory -> address -> offset -> num -> unit (* raises Type, Bounds *) diff --git a/interpreter/runtime/table.ml b/interpreter/runtime/table.ml index f48004d6..9958b7f7 100644 --- a/interpreter/runtime/table.ml +++ b/interpreter/runtime/table.ml @@ -1,16 +1,15 @@ open Types +open Values type size = int32 type index = int32 -type elem = .. -type elem += Uninitialized - -type table' = elem array +type table' = ref_ array type table = - {mutable content : table'; max : size option; elem_type : elem_type} + {mutable content : table'; max : size option; elem_type : ref_type} type t = table +exception Type exception Bounds exception SizeOverflow exception SizeLimit @@ -20,7 +19,7 @@ let within_limits size = function | Some max -> I32.le_u size max let create size = - try Lib.Array32.make size Uninitialized + try Lib.Array32.make size NullRef with Invalid_argument _ -> raise Out_of_memory let alloc (TableType ({min; max}, elem_type)) = @@ -45,10 +44,11 @@ let grow tab delta = let load tab i = try Lib.Array32.get tab.content i with Invalid_argument _ -> raise Bounds -let store tab i v = - try Lib.Array32.set tab.content i v with Invalid_argument _ -> raise Bounds +let store tab i r = + if not (match_ref_type (type_of_ref r) tab.elem_type) then raise Type; + try Lib.Array32.set tab.content i r with Invalid_argument _ -> raise Bounds -let blit tab offset elems = - let data = Array.of_list elems in +let blit tab offset rs = + let data = Array.of_list rs in try Lib.Array32.blit data 0l tab.content offset (Lib.Array32.length data) with Invalid_argument _ -> raise Bounds diff --git a/interpreter/runtime/table.mli b/interpreter/runtime/table.mli index 7956d986..ae5fe691 100644 --- a/interpreter/runtime/table.mli +++ b/interpreter/runtime/table.mli @@ -1,4 +1,5 @@ open Types +open Values type table type t = table @@ -6,9 +7,7 @@ type t = table type size = int32 type index = int32 -type elem = .. -type elem += Uninitialized - +exception Type exception Bounds exception SizeOverflow exception SizeLimit @@ -18,6 +17,6 @@ val type_of : table -> table_type val size : table -> size val grow : table -> size -> unit (* raises SizeOverflow, SizeLimit *) -val load : table -> index -> elem (* raises Bounds *) -val store : table -> index -> elem -> unit (* raises Bounds *) -val blit : table -> index -> elem list -> unit (* raises Bounds *) +val load : table -> index -> ref_ (* raises Bounds *) +val store : table -> index -> ref_ -> unit (* raises Type, Bounds *) +val blit : table -> index -> ref_ list -> unit (* raises Bounds *) diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index 3165756b..ca3f64d0 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -221,7 +221,7 @@ let run ts at = let assert_return lits ts at = let test lit = - let t', reinterpret = reinterpret_of (Values.type_of lit.it) in + let t', reinterpret = reinterpret_of (Values.type_of_num lit.it) in [ reinterpret @@ at; Const lit @@ at; reinterpret @@ at; @@ -231,24 +231,21 @@ let assert_return lits ts at = in [], List.flatten (List.rev_map test lits) let assert_return_nan_bitpattern nan_bitmask_of ts at = - let test t = - let t', reinterpret = reinterpret_of t in - [ reinterpret @@ at; - Const (nan_bitmask_of t' @@ at) @@ at; - Binary (and_of t') @@ at; - Const (canonical_nan_of t' @@ at) @@ at; - Compare (eq_of t') @@ at; - Test (Values.I32 I32Op.Eqz) @@ at; - BrIf (0l @@ at) @@ at ] + let test = function + | NumType t -> + let t', reinterpret = reinterpret_of t in + [ reinterpret @@ at; + Const (nan_bitmask_of t' @@ at) @@ at; + Binary (and_of t') @@ at; + Const (canonical_nan_of t' @@ at) @@ at; + Compare (eq_of t') @@ at; + Test (Values.I32 I32Op.Eqz) @@ at; + BrIf (0l @@ at) @@ at ] + | RefType _ -> [Br (0l @@ at) @@ at] in [], List.flatten (List.rev_map test ts) -let assert_return_canonical_nan = - (* The result may only differ from the canonical NaN in its sign bit *) - assert_return_nan_bitpattern abs_mask_of - -let assert_return_arithmetic_nan = - (* The result can be any NaN that's one everywhere the canonical NaN is one *) - assert_return_nan_bitpattern canonical_nan_of +let assert_return_canonical_nan = assert_return_nan_bitpattern abs_mask_of +let assert_return_arithmetic_nan = assert_return_nan_bitpattern canonical_nan_of let wrap module_name item_name wrap_action wrap_assertion at = let itypes, idesc, action = wrap_action at in @@ -267,10 +264,14 @@ let wrap module_name item_name wrap_action wrap_assertion at = Encode.encode m -let is_js_value_type = function +let is_js_num_type = function | I32Type -> true | I64Type | F32Type | F64Type -> false +let is_js_value_type = function + | NumType t -> is_js_num_type t + | RefType t -> true + let is_js_global_type = function | GlobalType (t, mut) -> is_js_value_type t && mut = Immutable @@ -380,9 +381,11 @@ let of_assertion mods ass = of_assertion' mods act "assert_return" (List.map of_literal lits) (Some (assert_return lits)) | AssertReturnCanonicalNaN act -> - of_assertion' mods act "assert_return_canonical_nan" [] (Some assert_return_canonical_nan) + of_assertion' mods act "assert_return_canonical_nan" [] + (Some assert_return_canonical_nan) | AssertReturnArithmeticNaN act -> - of_assertion' mods act "assert_return_arithmetic_nan" [] (Some assert_return_arithmetic_nan) + of_assertion' mods act "assert_return_arithmetic_nan" [] + (Some assert_return_arithmetic_nan) | AssertTrap (act, _) -> of_assertion' mods act "assert_trap" [] None | AssertExhaustion (act, _) -> diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml index d1ec2866..1256d1fd 100644 --- a/interpreter/script/run.ml +++ b/interpreter/script/run.ml @@ -239,7 +239,7 @@ let print_module x_opt m = flush_all () let print_result vs = - let ts = List.map Values.type_of vs in + let ts = List.map Values.type_of_value vs in Printf.printf "%s : %s\n" (Values.string_of_values vs) (Types.string_of_value_types ts); flush_all () @@ -299,7 +299,7 @@ let run_action act = let inst = lookup_instance x_opt act.at in (match Instance.export inst name with | Some (Instance.ExternFunc f) -> - Eval.invoke f (List.map (fun v -> v.it) vs) + Eval.invoke f (List.map (fun v -> Values.Num v.it) vs) | Some _ -> Assert.error act.at "export is not a function" | None -> Assert.error act.at "undefined export" ) @@ -380,16 +380,17 @@ let run_assertion ass = | AssertReturn (act, vs) -> trace ("Asserting return..."); let got_vs = run_action act in - let expect_vs = List.map (fun v -> v.it) vs in + let expect_vs = List.map (fun v -> Values.Num v.it) vs in assert_result ass.at (got_vs = expect_vs) got_vs print_result expect_vs | AssertReturnCanonicalNaN act -> trace ("Asserting return..."); let got_vs = run_action act in let is_canonical_nan = + let open Values in match got_vs with - | [Values.F32 got_f32] -> got_f32 = F32.pos_nan || got_f32 = F32.neg_nan - | [Values.F64 got_f64] -> got_f64 = F64.pos_nan || got_f64 = F64.neg_nan + | [Num (F32 got_f32)] -> got_f32 = F32.pos_nan || got_f32 = F32.neg_nan + | [Num (F64 got_f64)] -> got_f64 = F64.pos_nan || got_f64 = F64.neg_nan | _ -> false in assert_result ass.at is_canonical_nan got_vs print_endline "nan" @@ -397,11 +398,12 @@ let run_assertion ass = trace ("Asserting return..."); let got_vs = run_action act in let is_arithmetic_nan = + let open Values in match got_vs with - | [Values.F32 got_f32] -> + | [Num (F32 got_f32)] -> let pos_nan = F32.to_bits F32.pos_nan in Int32.logand (F32.to_bits got_f32) pos_nan = pos_nan - | [Values.F64 got_f64] -> + | [Num (F64 got_f64)] -> let pos_nan = F64.to_bits F64.pos_nan in Int64.logand (F64.to_bits got_f64) pos_nan = pos_nan | _ -> false diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index e2efa7ee..36aea442 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -56,7 +56,7 @@ type relop = (I32Op.relop, I64Op.relop, F32Op.relop, F64Op.relop) Values.op type cvtop = (I32Op.cvtop, I64Op.cvtop, F32Op.cvtop, F64Op.cvtop) Values.op type 'a memop = - {ty : value_type; align : int; offset : Memory.offset; sz : 'a option} + {ty : num_type; align : int; offset : Memory.offset; sz : 'a option} type loadop = (Memory.mem_size * Memory.extension) memop type storeop = Memory.mem_size memop @@ -64,7 +64,7 @@ type storeop = Memory.mem_size memop (* Expressions *) type var = int32 Source.phrase -type literal = Values.value Source.phrase +type literal = Values.num Source.phrase type name = int list type instr = instr' Source.phrase @@ -79,7 +79,7 @@ and instr' = | BrTable of var list * var (* indexed break *) | Return (* break from function body *) | Call of var (* call function *) - | CallIndirect of var (* call function through table *) + | CallIndirect of var * var (* call function through table *) | Drop (* forget a value *) | Select (* branchless conditional *) | GetLocal of var (* read local variable *) @@ -87,10 +87,13 @@ and instr' = | TeeLocal of var (* write local variable and keep value *) | GetGlobal of var (* read global variable *) | SetGlobal of var (* write global variable *) + | GetTable of var (* read table element *) + | SetTable of var (* write table element *) | Load of loadop (* read memory at address *) | Store of storeop (* write memory at address *) | CurrentMemory (* size of linear memory *) | GrowMemory (* grow linear memory *) + | Null (* null reference *) | Const of literal (* constant *) | Test of testop (* numeric test *) | Compare of relop (* numeric comparison *) diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index b207b193..60a84370 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -9,6 +9,7 @@ let i32_const n = Const (I32 n.it @@ n.at) let i64_const n = Const (I64 n.it @@ n.at) let f32_const n = Const (F32 n.it @@ n.at) let f64_const n = Const (F64 n.it @@ n.at) +let ref_null = Null let unreachable = Unreachable let nop = Nop @@ -23,13 +24,15 @@ let if_ ts es1 es2 = If (ts, es1, es2) let select = Select let call x = Call x -let call_indirect x = CallIndirect x +let call_indirect x y = CallIndirect (x, y) let get_local x = GetLocal x let set_local x = SetLocal x let tee_local x = TeeLocal x let get_global x = GetGlobal x let set_global x = SetGlobal x +let get_table x = GetTable x +let set_table x = SetTable x let i32_load align offset = Load {ty = I32Type; align; offset; sz = None} let i64_load align offset = Load {ty = I64Type; align; offset; sz = None} diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index f708e4b8..36cf8b0f 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -1,13 +1,14 @@ (* Types *) -type value_type = I32Type | I64Type | F32Type | F64Type -type elem_type = AnyFuncType +type num_type = I32Type | I64Type | F32Type | F64Type +type ref_type = NullRefType | AnyRefType | AnyFuncType +type value_type = NumType of num_type | RefType of ref_type type stack_type = value_type list type func_type = FuncType of stack_type * stack_type type 'a limits = {min : 'a; max : 'a option} type mutability = Immutable | Mutable -type table_type = TableType of Int32.t limits * elem_type +type table_type = TableType of Int32.t limits * ref_type type memory_type = MemoryType of Int32.t limits type global_type = GlobalType of value_type * mutability type extern_type = @@ -26,6 +27,21 @@ let size = function (* Subtyping *) +let match_num_type t1 t2 = + t1 = t2 + +let match_ref_type t1 t2 = + match t1, t2 with + | _, AnyRefType -> true + | NullRefType, _ -> true + | _, _ -> t1 = t2 + +let match_value_type t1 t2 = + match t1, t2 with + | NumType t1', NumType t2' -> match_num_type t1' t2' + | RefType t1', RefType t2' -> match_ref_type t1' t2' + | _, _ -> false + let match_limits lim1 lim2 = I32.ge_u lim1.min lim2.min && match lim1.max, lim2.max with @@ -68,19 +84,25 @@ let globals = (* String conversion *) -let string_of_value_type = function +let string_of_num_type = function | I32Type -> "i32" | I64Type -> "i64" | F32Type -> "f32" | F64Type -> "f64" +let string_of_ref_type = function + | NullRefType -> "nullref" + | AnyRefType -> "anyref" + | AnyFuncType -> "anyfunc" + +let string_of_value_type = function + | NumType t -> string_of_num_type t + | RefType t -> string_of_ref_type t + let string_of_value_types = function | [t] -> string_of_value_type t | ts -> "[" ^ String.concat " " (List.map string_of_value_type ts) ^ "]" -let string_of_elem_type = function - | AnyFuncType -> "anyfunc" - let string_of_limits {min; max} = I32.to_string_u min ^ (match max with None -> "" | Some n -> " " ^ I32.to_string_u n) @@ -89,7 +111,7 @@ let string_of_memory_type = function | MemoryType lim -> string_of_limits lim let string_of_table_type = function - | TableType (lim, t) -> string_of_limits lim ^ " " ^ string_of_elem_type t + | TableType (lim, t) -> string_of_limits lim ^ " " ^ string_of_ref_type t let string_of_global_type = function | GlobalType (t, Immutable) -> string_of_value_type t diff --git a/interpreter/syntax/values.ml b/interpreter/syntax/values.ml index dedc14ab..de22eb36 100644 --- a/interpreter/syntax/values.ml +++ b/interpreter/syntax/values.ml @@ -6,74 +6,63 @@ open Types type ('i32, 'i64, 'f32, 'f64) op = I32 of 'i32 | I64 of 'i64 | F32 of 'f32 | F64 of 'f64 -type value = (I32.t, I64.t, F32.t, F64.t) op +type num = (I32.t, I64.t, F32.t, F64.t) op + +type ref_ = .. +type ref_ += NullRef + +type value = Num of num | Ref of ref_ (* Typing *) -let type_of = function +let type_of_num = function | I32 _ -> I32Type | I64 _ -> I64Type | F32 _ -> F32Type | F64 _ -> F64Type -let default_value = function +let type_of_ref' = ref (function NullRef -> NullRefType | _ -> AnyRefType) +let type_of_ref r = !type_of_ref' r + +let type_of_value = function + | Num n -> NumType (type_of_num n) + | Ref r -> RefType (type_of_ref r) + + +(* Defaults *) + +let default_num = function | I32Type -> I32 I32.zero | I64Type -> I64 I64.zero | F32Type -> F32 F32.zero | F64Type -> F64 F64.zero +let default_ref = function + | _ -> NullRef + +let default_value = function + | NumType t' -> Num (default_num t') + | RefType t' -> Ref (default_ref t') + (* Conversion *) -let value_of_bool b = I32 (if b then 1l else 0l) +let value_of_bool b = Num (I32 (if b then 1l else 0l)) -let string_of_value = function +let string_of_num = function | I32 i -> I32.to_string_s i | I64 i -> I64.to_string_s i | F32 z -> F32.to_string z | F64 z -> F64.to_string z +let string_of_ref' = ref (function NullRef -> "null" | _ -> "ref") +let string_of_ref r = !string_of_ref' r + +let string_of_value = function + | Num n -> string_of_num n + | Ref r -> string_of_ref r + let string_of_values = function | [v] -> string_of_value v | vs -> "[" ^ String.concat " " (List.map string_of_value vs) ^ "]" - - -(* Injection & projection *) - -exception Value of value_type - -module type ValueType = -sig - type t - val to_value : t -> value - val of_value : value -> t (* raise Value *) -end - -module I32Value = -struct - type t = I32.t - let to_value i = I32 i - let of_value = function I32 i -> i | _ -> raise (Value I32Type) -end - -module I64Value = -struct - type t = I64.t - let to_value i = I64 i - let of_value = function I64 i -> i | _ -> raise (Value I64Type) -end - -module F32Value = -struct - type t = F32.t - let to_value i = F32 i - let of_value = function F32 z -> z | _ -> raise (Value F32Type) -end - -module F64Value = -struct - type t = F64.t - let to_value i = F64 i - let of_value = function F64 z -> z | _ -> raise (Value F64Type) -end diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index c12d268b..e56247ea 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -55,10 +55,10 @@ let break_string s = (* Types *) +let num_type t = string_of_num_type t +let ref_type t = string_of_ref_type t let value_type t = string_of_value_type t -let elem_type t = string_of_elem_type t - let decls kind ts = tab kind (atom value_type) ts let stack_type ts = decls "result" ts @@ -173,7 +173,7 @@ struct end let oper (intop, floatop) op = - value_type (type_of op) ^ "." ^ + num_type (type_of_num op) ^ "." ^ (match op with | I32 o -> intop "32" o | I64 o -> intop "64" o @@ -197,7 +197,7 @@ let extension = function | Memory.ZX -> "_u" let memop name {ty; align; offset; _} = - value_type ty ^ "." ^ name ^ + num_type ty ^ "." ^ name ^ (if offset = 0l then "" else " offset=" ^ nat32 offset) ^ (if 1 lsl align = size ty then "" else " align=" ^ nat (1 lsl align)) @@ -215,8 +215,8 @@ let storeop op = (* Expressions *) let var x = nat32 x.it -let value v = string_of_value v.it -let constop v = value_type (type_of v.it) ^ ".const" +let num v = string_of_num v.it +let constop v = num_type (type_of_num v.it) ^ ".const" let rec instr e = let head, inner = @@ -234,7 +234,8 @@ let rec instr e = "br_table " ^ String.concat " " (list var (xs @ [x])), [] | Return -> "return", [] | Call x -> "call " ^ var x, [] - | CallIndirect x -> "call_indirect", [Node ("type " ^ var x, [])] + | CallIndirect (x, y) -> + "call_indirect " ^ var x, [Node ("type " ^ var y, [])] | Drop -> "drop", [] | Select -> "select", [] | GetLocal x -> "get_local " ^ var x, [] @@ -242,11 +243,14 @@ let rec instr e = | TeeLocal x -> "tee_local " ^ var x, [] | GetGlobal x -> "get_global " ^ var x, [] | SetGlobal x -> "set_global " ^ var x, [] + | GetTable x -> "get_table " ^ var x, [] + | SetTable x -> "set_table " ^ var x, [] | Load op -> loadop op, [] | Store op -> storeop op, [] | CurrentMemory -> "current_memory", [] | GrowMemory -> "grow_memory", [] - | Const lit -> constop lit ^ " " ^ value lit, [] + | Null -> "ref.null", [] + | Const lit -> constop lit ^ " " ^ num lit, [] | Test op -> testop op, [] | Compare op -> relop op, [] | Unary op -> unop op, [] @@ -282,7 +286,7 @@ let start x = Node ("start " ^ var x, []) let table off i tab = let {ttype = TableType (lim, t)} = tab.it in Node ("table $" ^ nat (off + i) ^ " " ^ limits nat32 lim, - [atom elem_type t] + [atom ref_type t] ) let memory off i mem = diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 2a41d8cf..e61a5283 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -45,7 +45,7 @@ let string s = done; Buffer.contents b -let value_type = function +let num_type = function | "i32" -> Types.I32Type | "i64" -> Types.I64Type | "f32" -> Types.F32Type @@ -160,7 +160,13 @@ rule token = parse | '"'character*'\\'_ { error_nest (Lexing.lexeme_end_p lexbuf) lexbuf "illegal escape" } - | (nxx as t) { VALUE_TYPE (value_type t) } + | "nullref" { NULLREF } + | "anyref" { ANYREF } + | "anyfunc" { ANYFUNC } + | (nxx as t) { NUM_TYPE (num_type t) } + | "mut" { MUT } + + | "ref.null" { REF_NULL } | (nxx as t)".const" { let open Source in CONST (numop t @@ -173,8 +179,6 @@ rule token = parse (fun s -> let n = F64.of_string s.it in f64_const (n @@ s.at), Values.F64 n)) } - | "anyfunc" { ANYFUNC } - | "mut" { MUT } | "nop" { NOP } | "unreachable" { UNREACHABLE } @@ -198,6 +202,8 @@ rule token = parse | "tee_local" { TEE_LOCAL } | "get_global" { GET_GLOBAL } | "set_global" { SET_GLOBAL } + | "get_table" { GET_TABLE } + | "set_table" { SET_TABLE } | (nxx as t)".load" { LOAD (fun a o -> diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 685a05b0..7385eb0d 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -145,11 +145,12 @@ let inline_type_explicit (c : context) x ft at = %} -%token NAT INT FLOAT STRING VAR VALUE_TYPE ANYFUNC MUT LPAR RPAR +%token NAT INT FLOAT STRING VAR NULLREF ANYREF ANYFUNC NUM_TYPE MUT LPAR RPAR %token NOP DROP BLOCK END IF THEN ELSE SELECT LOOP BR BR_IF BR_TABLE %token CALL CALL_INDIRECT RETURN -%token GET_LOCAL SET_LOCAL TEE_LOCAL GET_GLOBAL SET_GLOBAL +%token GET_LOCAL SET_LOCAL TEE_LOCAL GET_GLOBAL SET_GLOBAL GET_TABLE SET_TABLE %token LOAD STORE OFFSET_EQ_NAT ALIGN_EQ_NAT +%token REF_NULL %token CONST UNARY BINARY TEST COMPARE CONVERT %token UNREACHABLE CURRENT_MEMORY GROW_MEMORY %token FUNC START TYPE PARAM RESULT LOCAL GLOBAL @@ -166,8 +167,8 @@ let inline_type_explicit (c : context) x ft at = %token FLOAT %token STRING %token VAR -%token VALUE_TYPE -%token Ast.instr' * Values.value> CONST +%token NUM_TYPE +%token Ast.instr' * Values.num> CONST %token UNARY %token BINARY %token TEST @@ -200,16 +201,22 @@ string_list : /* Types */ +ref_type : + | NULLREF { NullRefType } + | ANYREF { AnyRefType } + | ANYFUNC { AnyFuncType } + +value_type : + | NUM_TYPE { NumType $1 } + | ref_type { RefType $1 } + value_type_list : | /* empty */ { [] } - | VALUE_TYPE value_type_list { $1 :: $2 } - -elem_type : - | ANYFUNC { AnyFuncType } + | value_type value_type_list { $1 :: $2 } global_type : - | VALUE_TYPE { GlobalType ($1, Immutable) } - | LPAR MUT VALUE_TYPE RPAR { GlobalType ($3, Mutable) } + | value_type { GlobalType ($1, Immutable) } + | LPAR MUT value_type RPAR { GlobalType ($3, Mutable) } def_type : | LPAR FUNC func_type RPAR { $3 } @@ -223,11 +230,11 @@ func_type : FuncType (ins, $3 @ out) } | LPAR PARAM value_type_list RPAR func_type { let FuncType (ins, out) = $5 in FuncType ($3 @ ins, out) } - | LPAR PARAM bind_var VALUE_TYPE RPAR func_type /* Sugar */ + | LPAR PARAM bind_var value_type RPAR func_type /* Sugar */ { let FuncType (ins, out) = $6 in FuncType ($4 :: ins, out) } table_type : - | limits elem_type { TableType ($1, $2) } + | limits ref_type { TableType ($1, $2) } memory_type : | limits { MemoryType $1 } @@ -315,10 +322,13 @@ plain_instr : | TEE_LOCAL var { fun c -> tee_local ($2 c local) } | GET_GLOBAL var { fun c -> get_global ($2 c global) } | SET_GLOBAL var { fun c -> set_global ($2 c global) } + | GET_TABLE var { fun c -> get_table ($2 c table) } + | SET_TABLE var { fun c -> set_table ($2 c table) } | LOAD offset_opt align_opt { fun c -> $1 $3 $2 } | STORE offset_opt align_opt { fun c -> $1 $3 $2 } | CURRENT_MEMORY { fun c -> current_memory } | GROW_MEMORY { fun c -> grow_memory } + | REF_NULL { fun c -> ref_null } | CONST literal { fun c -> fst (literal $1 $2) } | TEST { fun c -> $1 } | COMPARE { fun c -> $1 } @@ -327,9 +337,12 @@ plain_instr : | CONVERT { fun c -> $1 } call_instr : - | CALL_INDIRECT call_instr_type + | CALL_INDIRECT var call_instr_type + { let at1 = ati 1 in + fun c -> let x, es = $3 c in call_indirect ($2 c table) x @@ at1, es } + | CALL_INDIRECT call_instr_type /* Sugar */ { let at1 = ati 1 in - fun c -> let x, es = $2 c in call_indirect x @@ at1, es } + fun c -> let x, es = $2 c in call_indirect (0l @@ at1) x @@ at1, es } call_instr_type : | type_use call_instr_params @@ -367,7 +380,7 @@ block_instr : let ts, es1 = $3 c' in if_ ts es1 ($6 c') } block_type : - | LPAR RESULT VALUE_TYPE RPAR { [$3] } + | LPAR RESULT value_type RPAR { [$3] } block : | block_type instr_list @@ -380,8 +393,11 @@ expr : /* Sugar */ expr1 : /* Sugar */ | plain_instr expr_list { fun c -> $2 c, $1 c } - | CALL_INDIRECT call_expr_type - { fun c -> let x, es = $2 c in es, call_indirect x } + | CALL_INDIRECT var call_expr_type + { fun c -> let x, es = $3 c in es, call_indirect ($2 c table) x } + | CALL_INDIRECT call_expr_type /* Sugar */ + { let at1 = ati 1 in + fun c -> let x, es = $2 c in es, call_indirect (0l @@ at1) x } | BLOCK labeling_opt block { fun c -> let c' = $2 c [] in let ts, es = $3 c' in [], block ts es } | LOOP labeling_opt block @@ -476,7 +492,7 @@ func_fields_import : /* Sugar */ | func_fields_import_result { $1 } | LPAR PARAM value_type_list RPAR func_fields_import { let FuncType (ins, out) = $5 in FuncType ($3 @ ins, out) } - | LPAR PARAM bind_var VALUE_TYPE RPAR func_fields_import /* Sugar */ + | LPAR PARAM bind_var value_type RPAR func_fields_import /* Sugar */ { let FuncType (ins, out) = $6 in FuncType ($4 :: ins, out) } func_fields_import_result : /* Sugar */ @@ -490,7 +506,7 @@ func_fields_body : { let FuncType (ins, out) = fst $5 in FuncType ($3 @ ins, out), fun c -> ignore (anon_locals c $3); snd $5 c } - | LPAR PARAM bind_var VALUE_TYPE RPAR func_fields_body /* Sugar */ + | LPAR PARAM bind_var value_type RPAR func_fields_body /* Sugar */ { let FuncType (ins, out) = fst $6 in FuncType ($4 :: ins, out), fun c -> ignore (bind_local c $3); snd $6 c } @@ -508,7 +524,7 @@ func_body : | LPAR LOCAL value_type_list RPAR func_body { fun c -> ignore (anon_locals c $3); let f = $5 c in {f with locals = $3 @ f.locals} } - | LPAR LOCAL bind_var VALUE_TYPE RPAR func_body /* Sugar */ + | LPAR LOCAL bind_var value_type RPAR func_body /* Sugar */ { fun c -> ignore (bind_local c $3); let f = $6 c in {f with locals = $4 :: f.locals} } @@ -544,7 +560,7 @@ table_fields : | inline_export table_fields /* Sugar */ { fun c x at -> let tabs, elems, ims, exs = $2 c x at in tabs, elems, ims, $1 (TableExport x) c :: exs } - | elem_type LPAR ELEM var_list RPAR /* Sugar */ + | ref_type LPAR ELEM var_list RPAR /* Sugar */ { fun c x at -> let init = $4 c func in let size = Int32.of_int (List.length init) in [{ttype = TableType ({min = size; max = Some size}, $1)} @@ at], diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 3bdb5e28..240d69ea 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -69,9 +69,13 @@ let string_of_infer_type t = let string_of_infer_types ts = "[" ^ String.concat " " (List.map string_of_infer_type ts) ^ "]" -let eq_ty t1 t2 = (t1 = t2 || t1 = None || t2 = None) +let sub_ty t1 t2 = + match t1, t2 with + | Some t1, Some t2 -> match_value_type t1 t2 + | _, _ -> true + let check_stack ts1 ts2 at = - require (List.length ts1 = List.length ts2 && List.for_all2 eq_ty ts1 ts2) at + require (List.length ts1 = List.length ts2 && List.for_all2 sub_ty ts2 ts1) at ("type mismatch: operator requires " ^ string_of_infer_types ts1 ^ " but stack has " ^ string_of_infer_types ts2) @@ -94,11 +98,11 @@ let peek i (ell, ts) = (* Type Synthesis *) -let type_value = Values.type_of -let type_unop = Values.type_of -let type_binop = Values.type_of -let type_testop = Values.type_of -let type_relop = Values.type_of +let type_num = Values.type_of_num +let type_unop = Values.type_of_num +let type_binop = Values.type_of_num +let type_testop = Values.type_of_num +let type_relop = Values.type_of_num let type_cvtop at = function | Values.I32 cvtop -> @@ -196,18 +200,18 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = check_arity (List.length ts) e.at; check_block {c with labels = ts :: c.labels} es1 ts e.at; check_block {c with labels = ts :: c.labels} es2 ts e.at; - [I32Type] --> ts + [NumType I32Type] --> ts | Br x -> label c x -->... [] | BrIf x -> - (label c x @ [I32Type]) --> label c x + (label c x @ [NumType I32Type]) --> label c x | BrTable (xs, x) -> let ts = label c x in List.iter (fun x' -> check_stack (known ts) (known (label c x')) x'.at) xs; - (label c x @ [I32Type]) -->... [] + (label c x @ [NumType I32Type]) -->... [] | Return -> c.results -->... [] @@ -216,17 +220,20 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = let FuncType (ins, out) = func c x in ins --> out - | CallIndirect x -> - ignore (table c (0l @@ e.at)); - let FuncType (ins, out) = type_ c x in - (ins @ [I32Type]) --> out + | CallIndirect (x, y) -> + let TableType (lim, t) = table c x in + let FuncType (ins, out) = type_ c y in + require (match_ref_type t AnyFuncType) x.at + ("type mismatch: operator requires table of functions, " ^ + "but table has " ^ string_of_ref_type t); + (ins @ [NumType I32Type]) --> out | Drop -> [peek 0 s] -~> [] | Select -> let t = peek 1 s in - [t; t; Some I32Type] -~> [t] + [t; t; Some (NumType I32Type)] -~> [t] | GetLocal x -> [] --> [local c x] @@ -246,45 +253,56 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = require (mut = Mutable) x.at "global is immutable"; [t] --> [] + | GetTable x -> + let TableType (lim, t) = table c x in + [NumType I32Type] --> [RefType t] + + | SetTable x -> + let TableType (lim, t) = table c x in + [NumType I32Type; RefType t] --> [] + | Load memop -> check_memop c memop (Lib.Option.map fst) e.at; - [I32Type] --> [memop.ty] + [NumType I32Type] --> [NumType memop.ty] | Store memop -> check_memop c memop (fun sz -> sz) e.at; - [I32Type; memop.ty] --> [] + [NumType I32Type; NumType memop.ty] --> [] | CurrentMemory -> ignore (memory c (0l @@ e.at)); - [] --> [I32Type] + [] --> [NumType I32Type] | GrowMemory -> ignore (memory c (0l @@ e.at)); - [I32Type] --> [I32Type] + [NumType I32Type] --> [NumType I32Type] + + | Null -> + [] --> [RefType NullRefType] | Const v -> - let t = type_value v.it in + let t = NumType (type_num v.it) in [] --> [t] | Test testop -> - let t = type_testop testop in - [t] --> [I32Type] + let t = NumType (type_testop testop) in + [t] --> [NumType I32Type] | Compare relop -> - let t = type_relop relop in - [t; t] --> [I32Type] + let t = NumType (type_relop relop) in + [t; t] --> [NumType I32Type] | Unary unop -> - let t = type_unop unop in + let t = NumType (type_unop unop) in [t] --> [t] | Binary binop -> - let t = type_binop binop in + let t = NumType (type_binop binop) in [t; t] --> [t] | Convert cvtop -> let t1, t2 = type_cvtop e.at cvtop in - [t1] --> [t2] + [NumType t1] --> [NumType t2] and check_seq (c : context) (es : instr list) : infer_stack_type = match es with @@ -314,9 +332,17 @@ let check_limits {min; max} at = require (I32.le_u min max) at "size minimum must not be greater than maximum" -let check_value_type (t : value_type) at = +let check_num_type (t : num_type) at = () +let check_ref_type (t : ref_type) at = + () + +let check_value_type (t : value_type) at = + match t with + | NumType t' -> check_num_type t' at + | RefType t' -> check_ref_type t' at + let check_func_type (ft : func_type) at = let FuncType (ins, out) = ft in List.iter (fun t -> check_value_type t at) ins; @@ -324,8 +350,9 @@ let check_func_type (ft : func_type) at = check_arity (List.length out) at let check_table_type (tt : table_type) at = - let TableType (lim, _) = tt in - check_limits lim at + let TableType (lim, t) = tt in + check_limits lim at; + check_ref_type t at let check_memory_size (sz : I32.t) at = require (I32.le_u sz 65536l) at @@ -368,6 +395,7 @@ let check_func (c : context) (f : func) = let is_const (c : context) (e : instr) = match e.it with + | Null | Const _ -> true | GetGlobal x -> let GlobalType (_, mut) = global c x in mut = Immutable | _ -> false @@ -390,13 +418,13 @@ let check_memory (c : context) (mem : memory) = let check_elem (c : context) (seg : table_segment) = let {index; offset; init} = seg.it in - check_const c offset I32Type; + check_const c offset (NumType I32Type); ignore (table c index); ignore (List.map (func c) init) let check_data (c : context) (seg : memory_segment) = let {index; offset; init} = seg.it in - check_const c offset I32Type; + check_const c offset (NumType I32Type); ignore (memory c index) let check_global (c : context) (glob : global) = @@ -475,7 +503,5 @@ let check_module (m : module_) = List.iter (check_func c) funcs; check_start c start; ignore (List.fold_left (check_export c) NameSet.empty exports); - require (List.length c.tables <= 1) m.at - "multiple tables are not allowed (yet)"; require (List.length c.memories <= 1) m.at "multiple memories are not allowed (yet)" diff --git a/test/core/binary.wast b/test/core/binary.wast index 8cfeed46..15f51beb 100644 --- a/test/core/binary.wast +++ b/test/core/binary.wast @@ -43,25 +43,6 @@ (assert_malformed (module binary "\00asm\00\00\01\00") "unknown binary version") (assert_malformed (module binary "\00asm\00\00\00\01") "unknown binary version") -;; call_indirect reserved byte equal to zero. -(assert_malformed - (module binary - "\00asm" "\01\00\00\00" - "\01\04\01\60\00\00" ;; Type section - "\03\02\01\00" ;; Function section - "\04\04\01\70\00\00" ;; Table section - "\0a\09\01" ;; Code section - - ;; function 0 - "\07\00" - "\41\00" ;; i32.const 0 - "\11\00" ;; call_indirect (type 0) - "\01" ;; call_indirect reserved byte is not equal to zero! - "\0b" ;; end - ) - "zero flag expected" -) - ;; grow_memory reserved byte equal to zero. (assert_malformed (module binary diff --git a/test/core/imports.wast b/test/core/imports.wast index 7c17f805..57138aef 100644 --- a/test/core/imports.wast +++ b/test/core/imports.wast @@ -298,19 +298,6 @@ (assert_trap (invoke "call" (i32.const 100)) "undefined element") -(assert_invalid - (module (import "" "" (table 10 anyfunc)) (import "" "" (table 10 anyfunc))) - "multiple tables" -) -(assert_invalid - (module (import "" "" (table 10 anyfunc)) (table 10 anyfunc)) - "multiple tables" -) -(assert_invalid - (module (table 10 anyfunc) (table 10 anyfunc)) - "multiple tables" -) - (module (import "test" "table-10-inf" (table 10 anyfunc))) (module (import "test" "table-10-inf" (table 5 anyfunc))) (module (import "test" "table-10-inf" (table 0 anyfunc))) From dbaaef68bc93f8a09e27442a02b4e3288e9f4fd7 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 5 Mar 2018 16:28:04 +0100 Subject: [PATCH 2/8] Implement equality; tweaks --- interpreter/binary/decode.ml | 12 +++- interpreter/binary/encode.ml | 13 ++-- interpreter/exec/eval.ml | 12 ++++ interpreter/script/js.ml | 105 ++++++++++++++++++++++---------- interpreter/script/run.ml | 4 +- interpreter/script/script.ml | 20 +++++- interpreter/syntax/ast.ml | 2 + interpreter/syntax/operators.ml | 3 + interpreter/syntax/types.ml | 3 +- interpreter/text/arrange.ml | 25 +++++--- interpreter/text/lexer.mll | 7 ++- interpreter/text/parser.mly | 14 +++-- interpreter/valid/valid.ml | 6 ++ test/core/ref_eq.wast | 50 +++++++++++++++ test/core/ref_isnull.wast | 64 +++++++++++++++++++ test/core/ref_null.wast | 9 +++ 16 files changed, 289 insertions(+), 60 deletions(-) create mode 100644 test/core/ref_eq.wast create mode 100644 test/core/ref_isnull.wast create mode 100644 test/core/ref_null.wast diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 11c52151..84e3d98b 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -143,7 +143,7 @@ let ref_type s = match vs7 s with | -0x10 -> AnyFuncType | -0x11 -> AnyRefType - | -0x12 -> NullRefType + | -0x12 -> EqRefType | _ -> error s (pos s - 1) "invalid reference type" let value_type s = @@ -269,7 +269,7 @@ let rec instr s = | 0x25 -> get_table (at var s) | 0x26 -> set_table (at var s) - | 0x27 -> ref_null + | 0x27 as b -> illegal s pos b | 0x28 -> let a, o = memop s in i32_load a o | 0x29 -> let a, o = memop s in i64_load a o @@ -441,6 +441,14 @@ let rec instr s = | 0xbe -> f32_reinterpret_i32 | 0xbf -> f64_reinterpret_i64 + | 0xc0 | 0xc1 | 0xc2 | 0xc3 | 0xc4 | 0xc5 | 0xc6 | 0xc7 + | 0xc8 | 0xc9 | 0xca | 0xcb | 0xcc | 0xcd | 0xce | 0xcf as b -> illegal s pos b + + (* TODO: Allocate more adequate opcodes *) + | 0xd0 -> ref_null + | 0xd1 -> ref_isnull + | 0xd2 -> ref_eq + | b -> illegal s pos b and instr_block s = List.rev (instr_block' s []) diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 2ee80656..d27b7e32 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -99,7 +99,8 @@ let encode m = let ref_type = function | AnyFuncType -> vs7 (-0x10) | AnyRefType -> vs7 (-0x11) - | NullRefType -> vs7 (-0x12) + | EqRefType -> vs7 (-0x12) + | NullRefType -> assert false let value_type = function | NumType t -> num_type t @@ -113,7 +114,8 @@ let encode m = "cannot encode stack type with arity > 1 (yet)" let func_type = function - | FuncType (ins, out) -> vs7 (-0x20); vec value_type ins; vec value_type out + | FuncType (ins, out) -> + vs7 (-0x20); vec value_type ins; vec value_type out let limits vu {min; max} = bool (max <> None); vu min; opt vu max @@ -175,8 +177,6 @@ let encode m = | GetTable x -> op 0x25; var x | SetTable x -> op 0x26; var x - | Null -> op 0x27 - | Load ({ty = I32Type; sz = None; _} as mo) -> op 0x28; memop mo | Load ({ty = I64Type; sz = None; _} as mo) -> op 0x29; memop mo | Load ({ty = F32Type; sz = None; _} as mo) -> op 0x2a; memop mo @@ -373,6 +373,11 @@ let encode m = | Convert (F64 F64Op.DemoteF64) -> assert false | Convert (F64 F64Op.ReinterpretInt) -> op 0xbf + (* TODO: Allocate more adequate opcodes *) + | Null -> op 0xd0 + | IsNull -> op 0xd1 + | Same -> op 0xd2 + let const c = list instr c.it; end_ () diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index bf6f2d0e..9a2f7c01 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -234,6 +234,18 @@ let rec step (c : config) : config = | Null, vs -> Ref NullRef :: vs, [] + | IsNull, Ref NullRef :: vs -> + Num (I32 1l) :: vs, [] + + | IsNull, v :: vs -> + Num (I32 0l) :: vs, [] + + | Same, Ref r2 :: Ref r1 :: vs when r1 = r2 -> + Num (I32 1l) :: vs, [] + + | Same, Ref r2 :: Ref r1 :: vs -> + Num (I32 0l) :: vs, [] + | Const n, vs -> Num n.it :: vs, [] diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index ca3f64d0..f290f83e 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -9,6 +9,12 @@ open Source let harness = "'use strict';\n" ^ "\n" ^ + "let hostrefs = {};\n" ^ + "function hostref(s) {\n" ^ + " if (! (s in hostrefs)) hostrefs[s] = {name: s};\n" ^ + " return hostrefs[s];\n" ^ + "}\n" ^ + "\n" ^ "let spectest = {\n" ^ " print: console.log.bind(console),\n" ^ " print_i32: console.log.bind(console),\n" ^ @@ -22,6 +28,7 @@ let harness = " table: new WebAssembly.Table({initial: 10, maximum: 20, element: 'anyfunc'}),\n" ^ " memory: new WebAssembly.Memory({initial: 1, maximum: 2})\n" ^ "};\n" ^ + "\n" ^ "let handler = {\n" ^ " get(target, prop) {\n" ^ " return (prop in target) ? target[prop] : {};\n" ^ @@ -64,8 +71,8 @@ let harness = " return instance.exports[name];\n" ^ "}\n" ^ "\n" ^ - "function exports(name, instance) {\n" ^ - " return {[name]: instance.exports};\n" ^ + "function exports(instance) {\n" ^ + " return {module: instance.exports, host: {ref: hostref}};\n" ^ "}\n" ^ "\n" ^ "function run(action) {\n" ^ @@ -209,9 +216,17 @@ let abs_mask_of = function | I32Type | F32Type -> Values.I32 Int32.max_int | I64Type | F64Type -> Values.I64 Int64.max_int -let invoke ft lits at = - [ft @@ at], FuncImport (1l @@ at) @@ at, - List.map (fun lit -> Const lit @@ at) lits @ [Call (0l @@ at) @@ at] +let value v = + match v.it with + | Values.Num num -> [Const (num @@ v.at) @@ v.at] + | Values.Ref Values.NullRef -> [Null @@ v.at] + | Values.Ref (HostRef n) -> + [Const (Values.I32 n @@ v.at) @@ v.at; Call (1l @@ v.at) @@ v.at] + | Values.Ref _ -> assert false + +let invoke ft vs at = + [ft @@ at], FuncImport (2l @@ at) @@ at, + List.concat (List.map value vs) @ [Call (0l @@ at) @@ at] let get t at = [], GlobalImport t @@ at, [GetGlobal (0l @@ at) @@ at] @@ -219,16 +234,29 @@ let get t at = let run ts at = [], [] -let assert_return lits ts at = - let test lit = - let t', reinterpret = reinterpret_of (Values.type_of_num lit.it) in - [ reinterpret @@ at; - Const lit @@ at; - reinterpret @@ at; - Compare (eq_of t') @@ at; - Test (Values.I32 I32Op.Eqz) @@ at; - BrIf (0l @@ at) @@ at ] - in [], List.flatten (List.rev_map test lits) +let assert_return vs ts at = + let test v = + match v.it with + | Values.Num num -> + let t', reinterpret = reinterpret_of (Values.type_of_num num) in + [ reinterpret @@ at; + Const (num @@ v.at) @@ at; + reinterpret @@ at; + Compare (eq_of t') @@ at; + Test (Values.I32 I32Op.Eqz) @@ at; + BrIf (0l @@ at) @@ at ] + | Values.Ref Values.NullRef -> + [ IsNull @@ at; + Test (Values.I32 I32Op.Eqz) @@ at; + BrIf (0l @@ at) @@ at ] + | Values.Ref (HostRef n) -> + [ Const (Values.I32 n @@ at) @@ at; + Call (1l @@ at) @@ at; + Same @@ at; + Test (Values.I32 I32Op.Eqz) @@ at; + BrIf (0l @@ at) @@ at ] + | _ -> assert false + in [], List.flatten (List.rev_map test vs) let assert_return_nan_bitpattern nan_bitmask_of ts at = let test = function @@ -247,12 +275,20 @@ let assert_return_nan_bitpattern nan_bitmask_of ts at = let assert_return_canonical_nan = assert_return_nan_bitpattern abs_mask_of let assert_return_arithmetic_nan = assert_return_nan_bitpattern canonical_nan_of -let wrap module_name item_name wrap_action wrap_assertion at = +let wrap item_name wrap_action wrap_assertion at = let itypes, idesc, action = wrap_action at in let locals, assertion = wrap_assertion at in let item = Lib.List32.length itypes @@ at in - let types = (FuncType ([], []) @@ at) :: itypes in - let imports = [{module_name; item_name; idesc} @@ at] in + let types = + (FuncType ([], []) @@ at) :: + (FuncType ([NumType I32Type], [RefType EqRefType]) @@ at) :: + itypes + in + let imports = + [ {module_name = Utf8.decode "module"; item_name; idesc} @@ at; + {module_name = Utf8.decode "host"; item_name = Utf8.decode "ref"; + idesc = FuncImport (1l @@ at) @@ at} @@ at ] + in let edesc = FuncExport item @@ at in let exports = [{name = Utf8.decode "run"; edesc} @@ at] in let body = @@ -303,7 +339,6 @@ let of_string_with iter add_char s = Buffer.contents buf let of_bytes = of_string_with String.iter add_hex_char -let of_string = of_string_with String.iter add_char let of_name = of_string_with List.iter add_unicode_char let of_float z = @@ -314,12 +349,16 @@ let of_float z = | "-inf" -> "-Infinity" | s -> s -let of_literal lit = - match lit.it with - | Values.I32 i -> I32.to_string_s i - | Values.I64 i -> "int64(\"" ^ I64.to_string_s i ^ "\")" - | Values.F32 z -> of_float (F32.to_float z) - | Values.F64 z -> of_float (F64.to_float z) +let of_value v = + let open Values in + match v.it with + | Num (I32 i) -> I32.to_string_s i + | Num (I64 i) -> "int64(\"" ^ I64.to_string_s i ^ "\")" + | Num (F32 z) -> of_float (F32.to_float z) + | Num (F64 z) -> of_float (F64.to_float z) + | Ref NullRef -> "null" + | Ref (HostRef n) -> "hostref(" ^ Int32.to_string n ^ ")" + | _ -> assert false let rec of_definition def = match def.it with @@ -331,19 +370,19 @@ let rec of_definition def = let of_wrapper mods x_opt name wrap_action wrap_assertion at = let x = of_var_opt mods x_opt in - let bs = wrap (Utf8.decode x) name wrap_action wrap_assertion at in + let bs = wrap name wrap_action wrap_assertion at in "call(instance(" ^ of_bytes bs ^ ", " ^ - "exports(" ^ of_string x ^ ", " ^ x ^ ")), " ^ " \"run\", [])" + "exports(" ^ x ^ ")), " ^ " \"run\", [])" let of_action mods act = match act.it with - | Invoke (x_opt, name, lits) -> + | Invoke (x_opt, name, vs) -> "call(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ", " ^ - "[" ^ String.concat ", " (List.map of_literal lits) ^ "])", + "[" ^ String.concat ", " (List.map of_value vs) ^ "])", (match lookup mods x_opt name act.at with | ExternFuncType ft when not (is_js_func_type ft) -> let FuncType (_, out) = ft in - Some (of_wrapper mods x_opt name (invoke ft lits), out) + Some (of_wrapper mods x_opt name (invoke ft vs), out) | _ -> None ) | Get (x_opt, name) -> @@ -377,9 +416,9 @@ let of_assertion mods ass = "assert_unlinkable(" ^ of_definition def ^ ");" | AssertUninstantiable (def, _) -> "assert_uninstantiable(" ^ of_definition def ^ ");" - | AssertReturn (act, lits) -> - of_assertion' mods act "assert_return" (List.map of_literal lits) - (Some (assert_return lits)) + | AssertReturn (act, vs) -> + of_assertion' mods act "assert_return" (List.map of_value vs) + (Some (assert_return vs)) | AssertReturnCanonicalNaN act -> of_assertion' mods act "assert_return_canonical_nan" [] (Some assert_return_canonical_nan) diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml index 1256d1fd..09bafd3e 100644 --- a/interpreter/script/run.ml +++ b/interpreter/script/run.ml @@ -299,7 +299,7 @@ let run_action act = let inst = lookup_instance x_opt act.at in (match Instance.export inst name with | Some (Instance.ExternFunc f) -> - Eval.invoke f (List.map (fun v -> Values.Num v.it) vs) + Eval.invoke f (List.map (fun v -> v.it) vs) | Some _ -> Assert.error act.at "export is not a function" | None -> Assert.error act.at "undefined export" ) @@ -380,7 +380,7 @@ let run_assertion ass = | AssertReturn (act, vs) -> trace ("Asserting return..."); let got_vs = run_action act in - let expect_vs = List.map (fun v -> Values.Num v.it) vs in + let expect_vs = List.map (fun v -> v.it) vs in assert_result ass.at (got_vs = expect_vs) got_vs print_result expect_vs | AssertReturnCanonicalNaN act -> diff --git a/interpreter/script/script.ml b/interpreter/script/script.ml index ca830254..48087e5a 100644 --- a/interpreter/script/script.ml +++ b/interpreter/script/script.ml @@ -1,5 +1,8 @@ type var = string Source.phrase +type Values.ref_ += HostRef of int32 +type value = Values.value Source.phrase + type definition = definition' Source.phrase and definition' = | Textual of Ast.module_ @@ -8,7 +11,7 @@ and definition' = type action = action' Source.phrase and action' = - | Invoke of var option * Ast.name * Ast.literal list + | Invoke of var option * Ast.name * value list | Get of var option * Ast.name type assertion = assertion' Source.phrase @@ -17,7 +20,7 @@ and assertion' = | AssertInvalid of definition * string | AssertUnlinkable of definition * string | AssertUninstantiable of definition * string - | AssertReturn of action * Ast.literal list + | AssertReturn of action * value list | AssertReturnCanonicalNaN of action | AssertReturnArithmeticNaN of action | AssertTrap of action * string @@ -40,3 +43,16 @@ and meta' = and script = command list exception Syntax of Source.region * string + + +let () = + let type_of_ref' = !Values.type_of_ref' in + Values.type_of_ref' := function + | HostRef _ -> Types.EqRefType + | r -> type_of_ref' r + +let () = + let string_of_ref' = !Values.string_of_ref' in + Values.string_of_ref' := function + | HostRef n -> "ref " ^ Int32.to_string n + | r -> string_of_ref' r diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 36aea442..7b783742 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -94,6 +94,8 @@ and instr' = | CurrentMemory (* size of linear memory *) | GrowMemory (* grow linear memory *) | Null (* null reference *) + | IsNull (* null test *) + | Same (* reference equality *) | Const of literal (* constant *) | Test of testop (* numeric test *) | Compare of relop (* numeric comparison *) diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 60a84370..05253bb1 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -11,6 +11,9 @@ let f32_const n = Const (F32 n.it @@ n.at) let f64_const n = Const (F64 n.it @@ n.at) let ref_null = Null +let ref_isnull = IsNull +let ref_eq = Same + let unreachable = Unreachable let nop = Nop let drop = Drop diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 36cf8b0f..11a09429 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -1,7 +1,7 @@ (* Types *) type num_type = I32Type | I64Type | F32Type | F64Type -type ref_type = NullRefType | AnyRefType | AnyFuncType +type ref_type = NullRefType | EqRefType | AnyRefType | AnyFuncType type value_type = NumType of num_type | RefType of ref_type type stack_type = value_type list type func_type = FuncType of stack_type * stack_type @@ -92,6 +92,7 @@ let string_of_num_type = function let string_of_ref_type = function | NullRefType -> "nullref" + | EqRefType -> "eqref" | AnyRefType -> "anyref" | AnyFuncType -> "anyfunc" diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index e56247ea..a6cdfd1a 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -250,6 +250,8 @@ let rec instr e = | CurrentMemory -> "current_memory", [] | GrowMemory -> "grow_memory", [] | Null -> "ref.null", [] + | IsNull -> "ref.isnull", [] + | Same -> "ref.eq", [] | Const lit -> constop lit ^ " " ^ num lit, [] | Test op -> testop op, [] | Compare op -> relop op, [] @@ -386,12 +388,15 @@ let module_ = module_with_var_opt None (* Scripts *) -let literal lit = - match lit.it with - | Values.I32 i -> Node ("i32.const " ^ I32.to_string_s i, []) - | Values.I64 i -> Node ("i64.const " ^ I64.to_string_s i, []) - | Values.F32 z -> Node ("f32.const " ^ F32.to_string z, []) - | Values.F64 z -> Node ("f64.const " ^ F64.to_string z, []) +let value v = + match v.it with + | Num (Values.I32 i) -> Node ("i32.const " ^ I32.to_string_s i, []) + | Num (Values.I64 i) -> Node ("i64.const " ^ I64.to_string_s i, []) + | Num (Values.F32 z) -> Node ("f32.const " ^ F32.to_string z, []) + | Num (Values.F64 z) -> Node ("f64.const " ^ F64.to_string z, []) + | Ref NullRef -> Node ("ref.null", []) + | Ref (HostRef n) -> Node ("ref " ^ Int32.to_string n, []) + | _ -> assert false let definition mode x_opt def = try @@ -420,8 +425,8 @@ let access x_opt n = let action act = match act.it with - | Invoke (x_opt, name, lits) -> - Node ("invoke" ^ access x_opt name, List.map literal lits) + | Invoke (x_opt, name, vs) -> + Node ("invoke" ^ access x_opt name, List.map value vs) | Get (x_opt, name) -> Node ("get" ^ access x_opt name, []) @@ -435,8 +440,8 @@ let assertion mode ass = Node ("assert_unlinkable", [definition mode None def; Atom (string re)]) | AssertUninstantiable (def, re) -> Node ("assert_trap", [definition mode None def; Atom (string re)]) - | AssertReturn (act, lits) -> - Node ("assert_return", action act :: List.map literal lits) + | AssertReturn (act, vs) -> + Node ("assert_return", action act :: List.map value vs) | AssertReturnCanonicalNaN act -> Node ("assert_return_canonical_nan", [action act]) | AssertReturnArithmeticNaN act -> diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index e61a5283..e8b7822c 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -160,13 +160,13 @@ rule token = parse | '"'character*'\\'_ { error_nest (Lexing.lexeme_end_p lexbuf) lexbuf "illegal escape" } - | "nullref" { NULLREF } + | "ref" { REF } + | "eqref" { EQREF } | "anyref" { ANYREF } | "anyfunc" { ANYFUNC } | (nxx as t) { NUM_TYPE (num_type t) } | "mut" { MUT } - | "ref.null" { REF_NULL } | (nxx as t)".const" { let open Source in CONST (numop t @@ -179,6 +179,9 @@ rule token = parse (fun s -> let n = F64.of_string s.it in f64_const (n @@ s.at), Values.F64 n)) } + | "ref.null" { REF_NULL } + | "ref.isnull" { REF_ISNULL } + | "ref.eq" { REF_EQ } | "nop" { NOP } | "unreachable" { UNREACHABLE } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 7385eb0d..ad2787b9 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -145,12 +145,14 @@ let inline_type_explicit (c : context) x ft at = %} -%token NAT INT FLOAT STRING VAR NULLREF ANYREF ANYFUNC NUM_TYPE MUT LPAR RPAR +%token LPAR RPAR +%token NAT INT FLOAT STRING VAR +%token REF EQREF ANYREF ANYFUNC NUM_TYPE MUT %token NOP DROP BLOCK END IF THEN ELSE SELECT LOOP BR BR_IF BR_TABLE %token CALL CALL_INDIRECT RETURN %token GET_LOCAL SET_LOCAL TEE_LOCAL GET_GLOBAL SET_GLOBAL GET_TABLE SET_TABLE %token LOAD STORE OFFSET_EQ_NAT ALIGN_EQ_NAT -%token REF_NULL +%token REF_NULL REF_ISNULL REF_EQ %token CONST UNARY BINARY TEST COMPARE CONVERT %token UNREACHABLE CURRENT_MEMORY GROW_MEMORY %token FUNC START TYPE PARAM RESULT LOCAL GLOBAL @@ -202,7 +204,7 @@ string_list : /* Types */ ref_type : - | NULLREF { NullRefType } + | EQREF { EqRefType } | ANYREF { AnyRefType } | ANYFUNC { AnyFuncType } @@ -329,6 +331,8 @@ plain_instr : | CURRENT_MEMORY { fun c -> current_memory } | GROW_MEMORY { fun c -> grow_memory } | REF_NULL { fun c -> ref_null } + | REF_ISNULL { fun c -> ref_isnull } + | REF_EQ { fun c -> ref_eq } | CONST literal { fun c -> fst (literal $1 $2) } | TEST { fun c -> $1 } | COMPARE { fun c -> $1 } @@ -805,7 +809,9 @@ meta : | LPAR OUTPUT script_var_opt RPAR { Output ($3, None) @@ at () } const : - | LPAR CONST literal RPAR { snd (literal $2 $3) @@ ati 3 } + | LPAR CONST literal RPAR { Values.Num (snd (literal $2 $3)) @@ at () } + | LPAR REF_NULL RPAR { Values.Ref Values.NullRef @@ at () } + | LPAR REF NAT RPAR { Values.Ref (HostRef (nat32 $3 (ati 3))) @@ at () } const_list : | /* empty */ { [] } diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 240d69ea..62c85880 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -280,6 +280,12 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = | Null -> [] --> [RefType NullRefType] + | IsNull -> + [RefType AnyRefType] --> [NumType I32Type] + + | Same -> + [RefType EqRefType; RefType EqRefType] --> [NumType I32Type] + | Const v -> let t = NumType (type_num v.it) in [] --> [t] diff --git a/test/core/ref_eq.wast b/test/core/ref_eq.wast new file mode 100644 index 00000000..56304a17 --- /dev/null +++ b/test/core/ref_eq.wast @@ -0,0 +1,50 @@ +(module + (func $eq (export "eq") (param $x eqref) (param $y eqref) (result i32) + (ref.eq (get_local $x) (get_local $y)) + ) + + (table $t 2 eqref) + + (func (export "init") (param $r eqref) + (set_table $t (i32.const 1) (get_local $r)) + ) + + (func (export "eq-elem") (param $i i32) (param $x eqref) (result i32) + (call $eq (get_table $t (get_local $i)) (get_local $x)) + ) +) + +(assert_return (invoke "eq" (ref.null) (ref.null)) (i32.const 1)) +(assert_return (invoke "eq" (ref 1) (ref 1)) (i32.const 1)) + +(assert_return (invoke "eq" (ref.null) (ref 0)) (i32.const 0)) +(assert_return (invoke "eq" (ref 0) (ref.null)) (i32.const 0)) +(assert_return (invoke "eq" (ref 1) (ref 2)) (i32.const 0)) + +(invoke "init" (ref 0)) + +(assert_return (invoke "eq-elem" (i32.const 0) (ref.null)) (i32.const 1)) +(assert_return (invoke "eq-elem" (i32.const 1) (ref 0)) (i32.const 1)) + +(assert_return (invoke "eq-elem" (i32.const 0) (ref 0)) (i32.const 0)) +(assert_return (invoke "eq-elem" (i32.const 1) (ref.null)) (i32.const 0)) +(assert_return (invoke "eq-elem" (i32.const 1) (ref 1)) (i32.const 0)) + + +(assert_invalid + (module + (func (param $x anyref) (param $y eqref) (result i32) + (ref.eq (get_local $x) (get_local $y)) + ) + ) + "type mismatch" +) + +(assert_invalid + (module + (func (param $x anyfunc) (param $y eqref) (result i32) + (ref.eq (get_local $x) (get_local $y)) + ) + ) + "type mismatch" +) diff --git a/test/core/ref_isnull.wast b/test/core/ref_isnull.wast new file mode 100644 index 00000000..bb4d57b8 --- /dev/null +++ b/test/core/ref_isnull.wast @@ -0,0 +1,64 @@ +(module + (func $f1 (export "eqref") (param $x eqref) (result i32) + (ref.isnull (get_local $x)) + ) + (func $f2 (export "anyref") (param $x anyref) (result i32) + (ref.isnull (get_local $x)) + ) + (func $f3 (export "anyfunc") (param $x anyfunc) (result i32) + (ref.isnull (get_local $x)) + ) + + (table $t1 2 eqref) + (table $t2 2 anyref) + (table $t3 2 anyfunc) (elem $t3 (i32.const 1) $dummy) + (func $dummy) + + (func (export "init") (param $r eqref) + (set_table $t1 (i32.const 1) (get_local $r)) + (set_table $t2 (i32.const 1) (get_local $r)) + ) + (func (export "deinit") + (set_table $t1 (i32.const 1) (ref.null)) + (set_table $t2 (i32.const 1) (ref.null)) + (set_table $t3 (i32.const 1) (ref.null)) + ) + + (func (export "eqref-elem") (param $x i32) (result i32) + (call $f1 (get_table $t1 (get_local $x))) + ) + (func (export "anyref-elem") (param $x i32) (result i32) + (call $f2 (get_table $t2 (get_local $x))) + ) + (func (export "anyfunc-elem") (param $x i32) (result i32) + (call $f3 (get_table $t3 (get_local $x))) + ) +) + +(assert_return (invoke "eqref" (ref.null)) (i32.const 1)) +(assert_return (invoke "anyref" (ref.null)) (i32.const 1)) +(assert_return (invoke "anyfunc" (ref.null)) (i32.const 1)) + +(assert_return (invoke "eqref" (ref 1)) (i32.const 0)) +(assert_return (invoke "anyref" (ref 1)) (i32.const 0)) +(assert_return (invoke "anyfunc" (ref 1)) (i32.const 0)) + +(invoke "init" (ref 0)) + +(assert_return (invoke "eqref-elem" (i32.const 0)) (i32.const 1)) +(assert_return (invoke "anyref-elem" (i32.const 0)) (i32.const 1)) +(assert_return (invoke "anyfunc-elem" (i32.const 0)) (i32.const 1)) + +(assert_return (invoke "eqref-elem" (i32.const 1)) (i32.const 0)) +(assert_return (invoke "anyref-elem" (i32.const 1)) (i32.const 0)) +(assert_return (invoke "anyfunc-elem" (i32.const 1)) (i32.const 0)) + +(invoke "deinit") + +(assert_return (invoke "eqref-elem" (i32.const 0)) (i32.const 1)) +(assert_return (invoke "anyref-elem" (i32.const 0)) (i32.const 1)) +(assert_return (invoke "anyfunc-elem" (i32.const 0)) (i32.const 1)) + +(assert_return (invoke "eqref-elem" (i32.const 1)) (i32.const 1)) +(assert_return (invoke "anyref-elem" (i32.const 1)) (i32.const 1)) +(assert_return (invoke "anyfunc-elem" (i32.const 1)) (i32.const 1)) diff --git a/test/core/ref_null.wast b/test/core/ref_null.wast new file mode 100644 index 00000000..a627b31e --- /dev/null +++ b/test/core/ref_null.wast @@ -0,0 +1,9 @@ +(module + (func (export "eqref") (result eqref) (ref.null)) + (func (export "anyref") (result anyref) (ref.null)) + (func (export "anyfunc") (result anyfunc) (ref.null)) +) + +(assert_return (invoke "eqref") (ref.null)) +(assert_return (invoke "anyref") (ref.null)) +(assert_return (invoke "anyfunc") (ref.null)) From ece61d24ddafbfe4745d77327b6f0cbedae4d3f2 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 5 Mar 2018 17:16:06 +0100 Subject: [PATCH 3/8] Adjust README --- interpreter/README.md | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/interpreter/README.md b/interpreter/README.md index af0ba204..6d0458c8 100644 --- a/interpreter/README.md +++ b/interpreter/README.md @@ -223,10 +223,15 @@ op: tee_local get_global set_global + get_table + set_table .load((8|16|32)_)? ? ? .store(8|16|32)? ? ? current_memory grow_memory + ref.null + ref.isnull + ref.eq .const . . @@ -272,9 +277,9 @@ exkind: ( func ) ( table ) ( memory ) -module: ( module ? * * * * ? ? * * * ? ) - * * * *
? ? * * * ? ;; = - ( module * * * *
? ? * * * ? ) +module: ( module ? * * * *
* ? * * * ? ) + * * * *
* ? * * * ? ;; = + ( module * * * *
* ? * * * ? ) ``` Here, productions marked with respective comments are abbreviation forms for equivalent expansions (see the explanation of the AST below). From d8b26182f5841131ea44ad963a3662deaa348906 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 5 Mar 2018 17:54:58 +0100 Subject: [PATCH 4/8] More tests --- interpreter/exec/eval.ml | 34 +++++++++++++-------- test/core/exports.wast | 12 ++++---- test/core/get_table.wast | 45 ++++++++++++++++++++++++++++ test/core/imports.wast | 19 +++++++++++- test/core/set_table.wast | 65 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 154 insertions(+), 21 deletions(-) create mode 100644 test/core/get_table.wast create mode 100644 test/core/set_table.wast diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 9a2f7c01..b601d804 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -17,6 +17,13 @@ exception Trap = Trap.Error exception Crash = Crash.Error (* failure that cannot happen in valid code *) exception Exhaustion = Exhaustion.Error +let table_error at = function + | Table.Bounds -> "out of bounds table access" + | Table.SizeOverflow -> "table size overflow" + | Table.SizeLimit -> "table size limit reached" + | Table.Type -> Crash.error at "type mismatch at table access" + | exn -> raise exn + let memory_error at = function | Memory.Bounds -> "out of bounds memory access" | Memory.SizeOverflow -> "memory size overflow" @@ -190,12 +197,13 @@ let rec step (c : config) : config = with Global.NotMutable -> Crash.error e.at "write to immutable global" | Global.Type -> Crash.error e.at "type mismatch at global write") - | GetTable x, Num (I32 i) :: vs -> - Ref (Table.load (table frame.inst x) i) :: vs, [] + | GetTable x, Num (I32 i) :: vs' -> + (try Ref (Table.load (table frame.inst x) i) :: vs', [] + with exn -> vs', [Trapping (table_error e.at exn) @@ e.at]) | SetTable x, Ref r :: Num (I32 i) :: vs' -> (try Table.store (table frame.inst x) i r; vs', [] - with Table.Type -> Crash.error e.at "type mismatch at table write") + with exn -> vs', [Trapping (table_error e.at exn) @@ e.at]) | Load {offset; ty; sz; _}, Num (I32 i) :: vs' -> let mem = memory frame.inst (0l @@ e.at) in @@ -231,20 +239,20 @@ let rec step (c : config) : config = with Memory.SizeOverflow | Memory.SizeLimit | Memory.OutOfMemory -> -1l in Num (I32 result) :: vs', [] - | Null, vs -> - Ref NullRef :: vs, [] + | Null, vs' -> + Ref NullRef :: vs', [] - | IsNull, Ref NullRef :: vs -> - Num (I32 1l) :: vs, [] + | IsNull, Ref NullRef :: vs' -> + Num (I32 1l) :: vs', [] - | IsNull, v :: vs -> - Num (I32 0l) :: vs, [] + | IsNull, v :: vs' -> + Num (I32 0l) :: vs', [] - | Same, Ref r2 :: Ref r1 :: vs when r1 = r2 -> - Num (I32 1l) :: vs, [] + | Same, Ref r2 :: Ref r1 :: vs' when r1 = r2 -> + Num (I32 1l) :: vs', [] - | Same, Ref r2 :: Ref r1 :: vs -> - Num (I32 0l) :: vs, [] + | Same, Ref r2 :: Ref r1 :: vs' -> + Num (I32 0l) :: vs', [] | Const n, vs -> Num n.it :: vs, [] diff --git a/test/core/exports.wast b/test/core/exports.wast index 6841aa87..0f4e3557 100644 --- a/test/core/exports.wast +++ b/test/core/exports.wast @@ -104,8 +104,7 @@ (module (table 0 anyfunc) (export "a" (table 0))) (module (table 0 anyfunc) (export "a" (table 0)) (export "b" (table 0))) -;; No multiple tables yet. -;; (module (table 0 anyfunc) (table 0 anyfunc) (export "a" (table 0)) (export "b" (table 1))) +(module (table 0 anyfunc) (table 0 anyfunc) (export "a" (table 0)) (export "b" (table 1))) (module (table (export "a") 0 anyfunc)) (module (table (export "a") 0 1 anyfunc)) @@ -130,11 +129,10 @@ (module (table 0 anyfunc) (export "a" (table 0)) (export "a" (table 0))) "duplicate export name" ) -;; No multiple tables yet. -;; (assert_invalid -;; (module (table 0 anyfunc) (table 0 anyfunc) (export "a" (table 0)) (export "a" (table 1))) -;; "duplicate export name" -;; ) +(assert_invalid + (module (table 0 anyfunc) (table 0 anyfunc) (export "a" (table 0)) (export "a" (table 1))) + "duplicate export name" +) (assert_invalid (module (table 0 anyfunc) (func) (export "a" (table 0)) (export "a" (func 0))) "duplicate export name" diff --git a/test/core/get_table.wast b/test/core/get_table.wast new file mode 100644 index 00000000..6f6bb16f --- /dev/null +++ b/test/core/get_table.wast @@ -0,0 +1,45 @@ +(module + (table $t1 2 eqref) + (table $t2 2 anyref) + (table $t3 3 anyfunc) (elem $t3 (i32.const 1) $dummy) + (func $dummy) + + (func (export "init") (param $r eqref) + (set_table $t1 (i32.const 1) (get_local $r)) + (set_table $t2 (i32.const 1) (get_local $r)) + (set_table $t3 (i32.const 2) (get_table $t3 (i32.const 1))) + ) + + (func (export "get-eqref") (param $i i32) (result eqref) + (get_table $t1 (get_local $i)) + ) + (func (export "get-anyref") (param $i i32) (result anyref) + (get_table $t2 (get_local $i)) + ) + (func $f3 (export "get-anyfunc") (param $i i32) (result anyfunc) + (get_table $t3 (get_local $i)) + ) + + (func (export "isnull-anyfunc") (param $i i32) (result i32) + (ref.isnull (call $f3 (get_local $i))) + ) +) + +(invoke "init" (ref 1)) + +(assert_return (invoke "get-eqref" (i32.const 0)) (ref.null)) +(assert_return (invoke "get-eqref" (i32.const 1)) (ref 1)) + +(assert_return (invoke "get-anyref" (i32.const 0)) (ref.null)) +(assert_return (invoke "get-anyref" (i32.const 1)) (ref 1)) + +(assert_return (invoke "get-anyfunc" (i32.const 0)) (ref.null)) +(assert_return (invoke "isnull-anyfunc" (i32.const 1)) (i32.const 0)) +(assert_return (invoke "isnull-anyfunc" (i32.const 2)) (i32.const 0)) + +(assert_trap (invoke "get-eqref" (i32.const 2)) "out of bounds") +(assert_trap (invoke "get-anyref" (i32.const 2)) "out of bounds") +(assert_trap (invoke "get-anyfunc" (i32.const 3)) "out of bounds") +(assert_trap (invoke "get-eqref" (i32.const -1)) "out of bounds") +(assert_trap (invoke "get-anyref" (i32.const -1)) "out of bounds") +(assert_trap (invoke "get-anyfunc" (i32.const -1)) "out of bounds") diff --git a/test/core/imports.wast b/test/core/imports.wast index 57138aef..37033e90 100644 --- a/test/core/imports.wast +++ b/test/core/imports.wast @@ -11,7 +11,7 @@ (global (export "global-i32") i32 (i32.const 55)) (global (export "global-f32") f32 (f32.const 44)) (table (export "table-10-inf") 10 anyfunc) - ;; (table (export "table-10-20") 10 20 anyfunc) + (table (export "table-10-20") 10 20 anyfunc) (memory (export "memory-2-inf") 2) ;; (memory (export "memory-2-4") 2 4) ) @@ -301,6 +301,15 @@ (module (import "test" "table-10-inf" (table 10 anyfunc))) (module (import "test" "table-10-inf" (table 5 anyfunc))) (module (import "test" "table-10-inf" (table 0 anyfunc))) +(module (import "test" "table-10-20" (table 10 anyfunc))) +(module (import "test" "table-10-20" (table 5 anyfunc))) +(module (import "test" "table-10-20" (table 0 anyfunc))) +(module (import "test" "table-10-20" (table 10 20 anyfunc))) +(module (import "test" "table-10-20" (table 5 20 anyfunc))) +(module (import "test" "table-10-20" (table 0 20 anyfunc))) +(module (import "test" "table-10-20" (table 10 25 anyfunc))) +(module (import "test" "table-10-20" (table 5 25 anyfunc))) +(module (import "test" "table-10-20" (table 0 25 anyfunc))) (module (import "spectest" "table" (table 10 anyfunc))) (module (import "spectest" "table" (table 5 anyfunc))) (module (import "spectest" "table" (table 0 anyfunc))) @@ -327,6 +336,14 @@ (module (import "test" "table-10-inf" (table 10 20 anyfunc))) "incompatible import type" ) +(assert_unlinkable + (module (import "test" "table-10-20" (table 12 20 anyfunc))) + "incompatible import type" +) +(assert_unlinkable + (module (import "test" "table-10-20" (table 10 18 anyfunc))) + "incompatible import type" +) (assert_unlinkable (module (import "spectest" "table" (table 12 anyfunc))) "incompatible import type" diff --git a/test/core/set_table.wast b/test/core/set_table.wast new file mode 100644 index 00000000..b36eb965 --- /dev/null +++ b/test/core/set_table.wast @@ -0,0 +1,65 @@ +(module + (table $t1 1 eqref) + (table $t2 1 anyref) + (table $t3 2 anyfunc) (elem $t3 (i32.const 1) $dummy) + (func $dummy) + + (func (export "get-eqref") (param $i i32) (result eqref) + (get_table $t1 (get_local $i)) + ) + (func (export "get-anyref") (param $i i32) (result anyref) + (get_table $t2 (get_local $i)) + ) + (func $f3 (export "get-anyfunc") (param $i i32) (result anyfunc) + (get_table $t3 (get_local $i)) + ) + + (func (export "set-eqref") (param $i i32) (param $r eqref) + (set_table $t1 (get_local $i) (get_local $r)) + ) + (func (export "set-anyref") (param $i i32) (param $r anyref) + (set_table $t2 (get_local $i) (get_local $r)) + ) + (func (export "set-anyfunc") (param $i i32) (param $r anyfunc) + (set_table $t3 (get_local $i) (get_local $r)) + ) + (func (export "set-anyfunc-from") (param $i i32) (param $j i32) + (set_table $t3 (get_local $i) (get_table $t3 (get_local $j))) + ) + + (func (export "isnull-anyfunc") (param $i i32) (result i32) + (ref.isnull (call $f3 (get_local $i))) + ) +) + +(assert_return (invoke "get-eqref" (i32.const 0)) (ref.null)) +(assert_return (invoke "set-eqref" (i32.const 0) (ref 1))) +(assert_return (invoke "get-eqref" (i32.const 0)) (ref 1)) +(assert_return (invoke "set-eqref" (i32.const 0) (ref.null))) +(assert_return (invoke "get-eqref" (i32.const 0)) (ref.null)) + +(assert_return (invoke "get-anyref" (i32.const 0)) (ref.null)) +(assert_return (invoke "set-anyref" (i32.const 0) (ref 1))) +(assert_return (invoke "get-anyref" (i32.const 0)) (ref 1)) +(assert_return (invoke "set-anyref" (i32.const 0) (ref.null))) +(assert_return (invoke "get-anyref" (i32.const 0)) (ref.null)) + +(assert_return (invoke "get-anyfunc" (i32.const 0)) (ref.null)) +(assert_return (invoke "set-anyfunc-from" (i32.const 0) (i32.const 1))) +(assert_return (invoke "isnull-anyfunc" (i32.const 0)) (i32.const 0)) +(assert_return (invoke "set-anyfunc" (i32.const 0) (ref.null))) +(assert_return (invoke "get-anyfunc" (i32.const 0)) (ref.null)) + +(assert_trap (invoke "set-eqref" (i32.const 2) (ref.null)) "out of bounds") +(assert_trap (invoke "set-anyref" (i32.const 2) (ref.null)) "out of bounds") +(assert_trap (invoke "set-anyfunc" (i32.const 3) (ref.null)) "out of bounds") +(assert_trap (invoke "set-eqref" (i32.const -1) (ref.null)) "out of bounds") +(assert_trap (invoke "set-anyref" (i32.const -1) (ref.null)) "out of bounds") +(assert_trap (invoke "set-anyfunc" (i32.const -1) (ref.null)) "out of bounds") + +(assert_trap (invoke "set-eqref" (i32.const 2) (ref 0)) "out of bounds") +(assert_trap (invoke "set-anyref" (i32.const 2) (ref 0)) "out of bounds") +(assert_trap (invoke "set-anyfunc-from" (i32.const 3) (i32.const 1)) "out of bounds") +(assert_trap (invoke "set-eqref" (i32.const -1) (ref 0)) "out of bounds") +(assert_trap (invoke "set-anyref" (i32.const -1) (ref 0)) "out of bounds") +(assert_trap (invoke "set-anyfunc-from" (i32.const -1) (i32.const 1)) "out of bounds") From c9c14cda96bb43c4f3e82d116e116ecb5793042b Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Tue, 6 Mar 2018 03:47:30 +0100 Subject: [PATCH 5/8] Fix README --- interpreter/README.md | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/interpreter/README.md b/interpreter/README.md index 6d0458c8..e5ac56cf 100644 --- a/interpreter/README.md +++ b/interpreter/README.md @@ -183,12 +183,13 @@ offset: offset= align: align=(1|2|4|8|...) cvtop: trunc_s | trunc_u | extend_s | extend_u | ... -val_type: i32 | i64 | f32 | f64 -elem_type: anyfunc +num_type: i32 | i64 | f32 | f64 +ref_type: anyref | anyfunc | eqref +val_type: num_type | ref_type block_type : ( result * )* func_type: ( type )? * * global_type: | ( mut ) -table_type: ? +table_type: ? memory_type: ? expr: @@ -225,19 +226,19 @@ op: set_global get_table set_table - .load((8|16|32)_)? ? ? - .store(8|16|32)? ? ? + .load((8|16|32)_)? ? ? + .store(8|16|32)? ? ? current_memory grow_memory ref.null ref.isnull ref.eq - .const - . - . - . - . - ./ + .const + . + . + . + . + ./ func: ( func ? * * ) ( func ? ( export ) <...> ) ;; = (export (func )) (func ? <...>) @@ -252,7 +253,7 @@ global: ( global ? * ) table: ( table ? ) ( table ? ( export ) <...> ) ;; = (export (table )) (table ? <...>) ( table ? ( import ) ) ;; = (import ? (table )) - ( table ? ( export )* ( elem * ) ) ;; = (table ? ( export )* ) (elem (i32.const 0) *) + ( table ? ( export )* ( elem * ) ) ;; = (table ? ( export )* ) (elem (i32.const 0) *) elem: ( elem ? (offset * ) * ) ( elem ? * ) ;; = (elem ? (offset ) *) memory: ( memory ? ) From 277fc27e051d98fd3b596777ccb709089e5d10b5 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Wed, 7 Mar 2018 14:56:24 +0100 Subject: [PATCH 6/8] Rename ref to ref.host for clarity --- interpreter/README.md | 15 ++++++++++----- interpreter/text/arrange.ml | 2 +- interpreter/text/lexer.mll | 2 +- interpreter/text/parser.mly | 6 +++--- test/core/get_table.wast | 6 +++--- test/core/ref_eq.wast | 16 ++++++++-------- test/core/ref_isnull.wast | 8 ++++---- test/core/set_table.wast | 16 ++++++++-------- 8 files changed, 38 insertions(+), 33 deletions(-) diff --git a/interpreter/README.md b/interpreter/README.md index e5ac56cf..23f5a370 100644 --- a/interpreter/README.md +++ b/interpreter/README.md @@ -172,8 +172,8 @@ float: .?(e|E )? | 0x.?(p|P )? name: $( | | _ | . | + | - | * | / | \ | ^ | ~ | = | < | > | ! | ? | @ | # | $ | % | & | | | : | ' | `)+ string: "( | \n | \t | \\ | \' | \" | \ | \u{+})*" -value: | -var: | +num: | +var: | unop: ctz | clz | popcnt | ... binop: add | sub | mul | ... @@ -233,7 +233,7 @@ op: ref.null ref.isnull ref.eq - .const + .const . . . @@ -326,11 +326,16 @@ module: ( module ? quote * ) ;; module quoted in text (may be malformed) action: - ( invoke ? * ) ;; invoke function export + ( invoke ? * ) ;; invoke function export ( get ? ) ;; get global export +const: + ( .const ) ;; number value + ( ref.null ) ;; null reference + ( ref.host ) ;; host reference + assertion: - ( assert_return * ) ;; assert action has expected results + ( assert_return * ) ;; assert action has expected results ( assert_return_canonical_nan ) ;; assert action results in NaN in a canonical form ( assert_return_arithmetic_nan ) ;; assert action results in NaN with 1 in MSB of fraction field ( assert_trap ) ;; assert action traps with given failure string diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index a6cdfd1a..31d3021d 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -395,7 +395,7 @@ let value v = | Num (Values.F32 z) -> Node ("f32.const " ^ F32.to_string z, []) | Num (Values.F64 z) -> Node ("f64.const " ^ F64.to_string z, []) | Ref NullRef -> Node ("ref.null", []) - | Ref (HostRef n) -> Node ("ref " ^ Int32.to_string n, []) + | Ref (HostRef n) -> Node ("ref.host " ^ Int32.to_string n, []) | _ -> assert false let definition mode x_opt def = diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index e8b7822c..87059fe3 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -160,7 +160,6 @@ rule token = parse | '"'character*'\\'_ { error_nest (Lexing.lexeme_end_p lexbuf) lexbuf "illegal escape" } - | "ref" { REF } | "eqref" { EQREF } | "anyref" { ANYREF } | "anyfunc" { ANYFUNC } @@ -180,6 +179,7 @@ rule token = parse f64_const (n @@ s.at), Values.F64 n)) } | "ref.null" { REF_NULL } + | "ref.host" { REF_HOST } | "ref.isnull" { REF_ISNULL } | "ref.eq" { REF_EQ } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index ad2787b9..1d48d110 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -147,12 +147,12 @@ let inline_type_explicit (c : context) x ft at = %token LPAR RPAR %token NAT INT FLOAT STRING VAR -%token REF EQREF ANYREF ANYFUNC NUM_TYPE MUT +%token EQREF ANYREF ANYFUNC NUM_TYPE MUT %token NOP DROP BLOCK END IF THEN ELSE SELECT LOOP BR BR_IF BR_TABLE %token CALL CALL_INDIRECT RETURN %token GET_LOCAL SET_LOCAL TEE_LOCAL GET_GLOBAL SET_GLOBAL GET_TABLE SET_TABLE %token LOAD STORE OFFSET_EQ_NAT ALIGN_EQ_NAT -%token REF_NULL REF_ISNULL REF_EQ +%token REF_NULL REF_HOST REF_ISNULL REF_EQ %token CONST UNARY BINARY TEST COMPARE CONVERT %token UNREACHABLE CURRENT_MEMORY GROW_MEMORY %token FUNC START TYPE PARAM RESULT LOCAL GLOBAL @@ -811,7 +811,7 @@ meta : const : | LPAR CONST literal RPAR { Values.Num (snd (literal $2 $3)) @@ at () } | LPAR REF_NULL RPAR { Values.Ref Values.NullRef @@ at () } - | LPAR REF NAT RPAR { Values.Ref (HostRef (nat32 $3 (ati 3))) @@ at () } + | LPAR REF_HOST NAT RPAR { Values.Ref (HostRef (nat32 $3 (ati 3))) @@ at () } const_list : | /* empty */ { [] } diff --git a/test/core/get_table.wast b/test/core/get_table.wast index 6f6bb16f..6b7e6750 100644 --- a/test/core/get_table.wast +++ b/test/core/get_table.wast @@ -25,13 +25,13 @@ ) ) -(invoke "init" (ref 1)) +(invoke "init" (ref.host 1)) (assert_return (invoke "get-eqref" (i32.const 0)) (ref.null)) -(assert_return (invoke "get-eqref" (i32.const 1)) (ref 1)) +(assert_return (invoke "get-eqref" (i32.const 1)) (ref.host 1)) (assert_return (invoke "get-anyref" (i32.const 0)) (ref.null)) -(assert_return (invoke "get-anyref" (i32.const 1)) (ref 1)) +(assert_return (invoke "get-anyref" (i32.const 1)) (ref.host 1)) (assert_return (invoke "get-anyfunc" (i32.const 0)) (ref.null)) (assert_return (invoke "isnull-anyfunc" (i32.const 1)) (i32.const 0)) diff --git a/test/core/ref_eq.wast b/test/core/ref_eq.wast index 56304a17..c17458b2 100644 --- a/test/core/ref_eq.wast +++ b/test/core/ref_eq.wast @@ -15,20 +15,20 @@ ) (assert_return (invoke "eq" (ref.null) (ref.null)) (i32.const 1)) -(assert_return (invoke "eq" (ref 1) (ref 1)) (i32.const 1)) +(assert_return (invoke "eq" (ref.host 1) (ref.host 1)) (i32.const 1)) -(assert_return (invoke "eq" (ref.null) (ref 0)) (i32.const 0)) -(assert_return (invoke "eq" (ref 0) (ref.null)) (i32.const 0)) -(assert_return (invoke "eq" (ref 1) (ref 2)) (i32.const 0)) +(assert_return (invoke "eq" (ref.null) (ref.host 0)) (i32.const 0)) +(assert_return (invoke "eq" (ref.host 0) (ref.null)) (i32.const 0)) +(assert_return (invoke "eq" (ref.host 1) (ref.host 2)) (i32.const 0)) -(invoke "init" (ref 0)) +(invoke "init" (ref.host 0)) (assert_return (invoke "eq-elem" (i32.const 0) (ref.null)) (i32.const 1)) -(assert_return (invoke "eq-elem" (i32.const 1) (ref 0)) (i32.const 1)) +(assert_return (invoke "eq-elem" (i32.const 1) (ref.host 0)) (i32.const 1)) -(assert_return (invoke "eq-elem" (i32.const 0) (ref 0)) (i32.const 0)) +(assert_return (invoke "eq-elem" (i32.const 0) (ref.host 0)) (i32.const 0)) (assert_return (invoke "eq-elem" (i32.const 1) (ref.null)) (i32.const 0)) -(assert_return (invoke "eq-elem" (i32.const 1) (ref 1)) (i32.const 0)) +(assert_return (invoke "eq-elem" (i32.const 1) (ref.host 1)) (i32.const 0)) (assert_invalid diff --git a/test/core/ref_isnull.wast b/test/core/ref_isnull.wast index bb4d57b8..89b84098 100644 --- a/test/core/ref_isnull.wast +++ b/test/core/ref_isnull.wast @@ -39,11 +39,11 @@ (assert_return (invoke "anyref" (ref.null)) (i32.const 1)) (assert_return (invoke "anyfunc" (ref.null)) (i32.const 1)) -(assert_return (invoke "eqref" (ref 1)) (i32.const 0)) -(assert_return (invoke "anyref" (ref 1)) (i32.const 0)) -(assert_return (invoke "anyfunc" (ref 1)) (i32.const 0)) +(assert_return (invoke "eqref" (ref.host 1)) (i32.const 0)) +(assert_return (invoke "anyref" (ref.host 1)) (i32.const 0)) +(assert_return (invoke "anyfunc" (ref.host 1)) (i32.const 0)) -(invoke "init" (ref 0)) +(invoke "init" (ref.host 0)) (assert_return (invoke "eqref-elem" (i32.const 0)) (i32.const 1)) (assert_return (invoke "anyref-elem" (i32.const 0)) (i32.const 1)) diff --git a/test/core/set_table.wast b/test/core/set_table.wast index b36eb965..0a6747bc 100644 --- a/test/core/set_table.wast +++ b/test/core/set_table.wast @@ -33,14 +33,14 @@ ) (assert_return (invoke "get-eqref" (i32.const 0)) (ref.null)) -(assert_return (invoke "set-eqref" (i32.const 0) (ref 1))) -(assert_return (invoke "get-eqref" (i32.const 0)) (ref 1)) +(assert_return (invoke "set-eqref" (i32.const 0) (ref.host 1))) +(assert_return (invoke "get-eqref" (i32.const 0)) (ref.host 1)) (assert_return (invoke "set-eqref" (i32.const 0) (ref.null))) (assert_return (invoke "get-eqref" (i32.const 0)) (ref.null)) (assert_return (invoke "get-anyref" (i32.const 0)) (ref.null)) -(assert_return (invoke "set-anyref" (i32.const 0) (ref 1))) -(assert_return (invoke "get-anyref" (i32.const 0)) (ref 1)) +(assert_return (invoke "set-anyref" (i32.const 0) (ref.host 1))) +(assert_return (invoke "get-anyref" (i32.const 0)) (ref.host 1)) (assert_return (invoke "set-anyref" (i32.const 0) (ref.null))) (assert_return (invoke "get-anyref" (i32.const 0)) (ref.null)) @@ -57,9 +57,9 @@ (assert_trap (invoke "set-anyref" (i32.const -1) (ref.null)) "out of bounds") (assert_trap (invoke "set-anyfunc" (i32.const -1) (ref.null)) "out of bounds") -(assert_trap (invoke "set-eqref" (i32.const 2) (ref 0)) "out of bounds") -(assert_trap (invoke "set-anyref" (i32.const 2) (ref 0)) "out of bounds") +(assert_trap (invoke "set-eqref" (i32.const 2) (ref.host 0)) "out of bounds") +(assert_trap (invoke "set-anyref" (i32.const 2) (ref.host 0)) "out of bounds") (assert_trap (invoke "set-anyfunc-from" (i32.const 3) (i32.const 1)) "out of bounds") -(assert_trap (invoke "set-eqref" (i32.const -1) (ref 0)) "out of bounds") -(assert_trap (invoke "set-anyref" (i32.const -1) (ref 0)) "out of bounds") +(assert_trap (invoke "set-eqref" (i32.const -1) (ref.host 0)) "out of bounds") +(assert_trap (invoke "set-anyref" (i32.const -1) (ref.host 0)) "out of bounds") (assert_trap (invoke "set-anyfunc-from" (i32.const -1) (i32.const 1)) "out of bounds") From b9fc5efc683be19c68b7ae49d868ed072cd7ba9e Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 15 Mar 2018 16:21:25 +0100 Subject: [PATCH 7/8] Adapt to spec changes --- interpreter/README.md | 2 +- interpreter/binary/decode.ml | 2 +- interpreter/binary/encode.ml | 2 +- interpreter/script/js.ml | 76 +++++++++++++++++++++++++++++++----- interpreter/script/run.ml | 20 ++++++++++ interpreter/script/script.ml | 4 +- interpreter/syntax/types.ml | 48 ++++++++++++++++++++++- interpreter/text/arrange.ml | 4 ++ interpreter/text/lexer.mll | 4 +- interpreter/text/parser.mly | 9 +++-- interpreter/util/lib.ml | 5 +++ interpreter/util/lib.mli | 1 + interpreter/valid/valid.ml | 31 ++++++++++----- test/core/br_table.wast | 67 +++++++++++++++++++++++++++++++ test/core/select.wast | 32 +++++++++++++++ 15 files changed, 279 insertions(+), 28 deletions(-) diff --git a/interpreter/README.md b/interpreter/README.md index 23f5a370..c2b656ba 100644 --- a/interpreter/README.md +++ b/interpreter/README.md @@ -184,7 +184,7 @@ align: align=(1|2|4|8|...) cvtop: trunc_s | trunc_u | extend_s | extend_u | ... num_type: i32 | i64 | f32 | f64 -ref_type: anyref | anyfunc | eqref +ref_type: anyref | anyfunc | anyeqref val_type: num_type | ref_type block_type : ( result * )* func_type: ( type )? * * diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 84e3d98b..6648f673 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -143,7 +143,7 @@ let ref_type s = match vs7 s with | -0x10 -> AnyFuncType | -0x11 -> AnyRefType - | -0x12 -> EqRefType + | -0x12 -> AnyEqRefType | _ -> error s (pos s - 1) "invalid reference type" let value_type s = diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index d27b7e32..d0744335 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -99,7 +99,7 @@ let encode m = let ref_type = function | AnyFuncType -> vs7 (-0x10) | AnyRefType -> vs7 (-0x11) - | EqRefType -> vs7 (-0x12) + | AnyEqRefType -> vs7 (-0x12) | NullRefType -> assert false let value_type = function diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index f290f83e..5739c561 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -10,12 +10,22 @@ let harness = "'use strict';\n" ^ "\n" ^ "let hostrefs = {};\n" ^ + "let hostsym = Symbol(\"hostref\");\n" ^ "function hostref(s) {\n" ^ - " if (! (s in hostrefs)) hostrefs[s] = {name: s};\n" ^ + " if (! (s in hostrefs)) hostrefs[s] = {[hostsym]: s};\n" ^ " return hostrefs[s];\n" ^ "}\n" ^ + "function is_hostref(x) {\n" ^ + " return (x !== null && hostsym in x) ? 1 : 0;\n" ^ + "}\n" ^ + "function is_funcref(x) {\n" ^ + " return typeof x === \"function\" ? 1 : 0;\n" ^ + "}\n" ^ "\n" ^ "let spectest = {\n" ^ + " hostref: hostref,\n" ^ + " is_hostref: is_hostref,\n" ^ + " is_funcref: is_funcref,\n" ^ " print: console.log.bind(console),\n" ^ " print_i32: console.log.bind(console),\n" ^ " print_i32_f32: console.log.bind(console),\n" ^ @@ -150,6 +160,20 @@ let harness = " throw new Error(\"Wasm return value NaN expected, got \" + actual);\n" ^ " };\n" ^ "}\n" ^ + "\n" ^ + "function assert_return_ref(action) {\n" ^ + " let actual = action();\n" ^ + " if (actual === null || typeof actual !== \"object\" && typeof actual !== \"function\") {\n" ^ + " throw new Error(\"Wasm reference return value expected, got \" + actual);\n" ^ + " };\n" ^ + "}\n" ^ + "\n" ^ + "function assert_return_func(action) {\n" ^ + " let actual = action();\n" ^ + " if (typeof actual !== \"function\") {\n" ^ + " throw new Error(\"Wasm function return value expected, got \" + actual);\n" ^ + " };\n" ^ + "}\n" ^ "\n" @@ -192,6 +216,12 @@ let lookup (mods : modules) x_opt name at = (* Wrappers *) +let subject_idx = 0l +let hostref_idx = 1l +let _is_hostref_idx = 2l +let is_funcref_idx = 3l +let subject_type_idx = 4l + let eq_of = function | I32Type -> Values.I32 I32Op.Eq | I64Type -> Values.I64 I64Op.Eq @@ -221,15 +251,15 @@ let value v = | Values.Num num -> [Const (num @@ v.at) @@ v.at] | Values.Ref Values.NullRef -> [Null @@ v.at] | Values.Ref (HostRef n) -> - [Const (Values.I32 n @@ v.at) @@ v.at; Call (1l @@ v.at) @@ v.at] + [Const (Values.I32 n @@ v.at) @@ v.at; Call (hostref_idx @@ v.at) @@ v.at] | Values.Ref _ -> assert false let invoke ft vs at = - [ft @@ at], FuncImport (2l @@ at) @@ at, - List.concat (List.map value vs) @ [Call (0l @@ at) @@ at] + [ft @@ at], FuncImport (subject_type_idx @@ at) @@ at, + List.concat (List.map value vs) @ [Call (subject_idx @@ at) @@ at] let get t at = - [], GlobalImport t @@ at, [GetGlobal (0l @@ at) @@ at] + [], GlobalImport t @@ at, [GetGlobal (subject_idx @@ at) @@ at] let run ts at = [], [] @@ -251,7 +281,7 @@ let assert_return vs ts at = BrIf (0l @@ at) @@ at ] | Values.Ref (HostRef n) -> [ Const (Values.I32 n @@ at) @@ at; - Call (1l @@ at) @@ at; + Call (hostref_idx @@ at) @@ at; Same @@ at; Test (Values.I32 I32Op.Eqz) @@ at; BrIf (0l @@ at) @@ at ] @@ -275,19 +305,43 @@ let assert_return_nan_bitpattern nan_bitmask_of ts at = let assert_return_canonical_nan = assert_return_nan_bitpattern abs_mask_of let assert_return_arithmetic_nan = assert_return_nan_bitpattern canonical_nan_of +let assert_return_ref ts at = + let test = function + | NumType _ -> [Br (0l @@ at) @@ at] + | RefType _ -> + [ Null @@ at; + Same @@ at; + BrIf (0l @@ at) @@ at ] + in [], List.flatten (List.rev_map test ts) + +let assert_return_func ts at = + let test = function + | NumType _ -> [Br (0l @@ at) @@ at] + | RefType _ -> + [ Call (is_funcref_idx @@ at) @@ at; + Test (Values.I32 I32Op.Eqz) @@ at; + BrIf (0l @@ at) @@ at ] + in [], List.flatten (List.rev_map test ts) + let wrap item_name wrap_action wrap_assertion at = let itypes, idesc, action = wrap_action at in let locals, assertion = wrap_assertion at in let item = Lib.List32.length itypes @@ at in let types = (FuncType ([], []) @@ at) :: - (FuncType ([NumType I32Type], [RefType EqRefType]) @@ at) :: + (FuncType ([NumType I32Type], [RefType AnyEqRefType]) @@ at) :: + (FuncType ([RefType AnyEqRefType], [NumType I32Type]) @@ at) :: + (FuncType ([RefType AnyEqRefType], [NumType I32Type]) @@ at) :: itypes in let imports = [ {module_name = Utf8.decode "module"; item_name; idesc} @@ at; - {module_name = Utf8.decode "host"; item_name = Utf8.decode "ref"; - idesc = FuncImport (1l @@ at) @@ at} @@ at ] + {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "hostref"; + idesc = FuncImport (1l @@ at) @@ at} @@ at; + {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "is_hostref"; + idesc = FuncImport (2l @@ at) @@ at} @@ at; + {module_name = Utf8.decode "spectest"; item_name = Utf8.decode "is_funcref"; + idesc = FuncImport (3l @@ at) @@ at} @@ at ] in let edesc = FuncExport item @@ at in let exports = [{name = Utf8.decode "run"; edesc} @@ at] in @@ -425,6 +479,10 @@ let of_assertion mods ass = | AssertReturnArithmeticNaN act -> of_assertion' mods act "assert_return_arithmetic_nan" [] (Some assert_return_arithmetic_nan) + | AssertReturnRef act -> + of_assertion' mods act "assert_return_ref" [] (Some assert_return_ref) + | AssertReturnFunc act -> + of_assertion' mods act "assert_return_func" [] (Some assert_return_func) | AssertTrap (act, _) -> of_assertion' mods act "assert_trap" [] None | AssertExhaustion (act, _) -> diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml index 09bafd3e..0dfdd0f7 100644 --- a/interpreter/script/run.ml +++ b/interpreter/script/run.ml @@ -409,6 +409,26 @@ let run_assertion ass = | _ -> false in assert_result ass.at is_arithmetic_nan got_vs print_endline "nan" + | AssertReturnRef act -> + trace ("Asserting return..."); + let got_vs = run_action act in + let is_ref = + let open Values in + match got_vs with + | [Ref r] -> r <> NullRef + | _ -> false + in assert_result ass.at is_ref got_vs print_endline "ref" + + | AssertReturnFunc act -> + trace ("Asserting return..."); + let got_vs = run_action act in + let is_func = + let open Values in + match got_vs with + | [Ref r] -> r <> NullRef + | _ -> false + in assert_result ass.at is_func got_vs print_endline "func" + | AssertTrap (act, re) -> trace ("Asserting trap..."); (match run_action act with diff --git a/interpreter/script/script.ml b/interpreter/script/script.ml index 48087e5a..af96ee00 100644 --- a/interpreter/script/script.ml +++ b/interpreter/script/script.ml @@ -23,6 +23,8 @@ and assertion' = | AssertReturn of action * value list | AssertReturnCanonicalNaN of action | AssertReturnArithmeticNaN of action + | AssertReturnRef of action + | AssertReturnFunc of action | AssertTrap of action * string | AssertExhaustion of action * string @@ -48,7 +50,7 @@ exception Syntax of Source.region * string let () = let type_of_ref' = !Values.type_of_ref' in Values.type_of_ref' := function - | HostRef _ -> Types.EqRefType + | HostRef _ -> Types.AnyEqRefType | r -> type_of_ref' r let () = diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 11a09429..45b262ce 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -1,7 +1,7 @@ (* Types *) type num_type = I32Type | I64Type | F32Type | F64Type -type ref_type = NullRefType | EqRefType | AnyRefType | AnyFuncType +type ref_type = NullRefType | AnyEqRefType | AnyRefType | AnyFuncType type value_type = NumType of num_type | RefType of ref_type type stack_type = value_type list type func_type = FuncType of stack_type * stack_type @@ -70,6 +70,50 @@ let match_extern_type et1 et2 = | _, _ -> false +(* Meet and join *) + +let join_num_type t1 t2 = + if t1 = t2 then Some t1 else None + +let join_ref_type t1 t2 = + match t1, t2 with + | AnyRefType, _ | _, NullRefType -> Some t1 + | _, AnyRefType | NullRefType, _ -> Some t2 + | _, _ when t1 = t2 -> Some t1 + | _, _ -> Some AnyRefType + +let join_value_type t1 t2 = + match t1, t2 with + | NumType t1', NumType t2' -> + Lib.Option.map (fun t' -> NumType t') (join_num_type t1' t2') + | RefType t1', RefType t2' -> + Lib.Option.map (fun t' -> RefType t') (join_ref_type t1' t2') + | _, _ -> None + + +let meet_num_type t1 t2 = + if t1 = t2 then Some t1 else None + +let meet_ref_type t1 t2 = + match t1, t2 with + | _, AnyRefType | NullRefType, _ -> Some t1 + | AnyRefType, _ | _, NullRefType -> Some t2 + | _, _ when t1 = t2 -> Some t1 + | _, _ -> Some NullRefType + +let meet_value_type t1 t2 = + match t1, t2 with + | NumType t1', NumType t2' -> + Lib.Option.map (fun t' -> NumType t') (meet_num_type t1' t2') + | RefType t1', RefType t2' -> + Lib.Option.map (fun t' -> RefType t') (meet_ref_type t1' t2') + | _, _ -> None + +let meet_stack_type ts1 ts2 = + try Some (List.map Lib.Option.force (List.map2 meet_value_type ts1 ts2)) + with Invalid_argument _ -> None + + (* Filters *) let funcs = @@ -92,7 +136,7 @@ let string_of_num_type = function let string_of_ref_type = function | NullRefType -> "nullref" - | EqRefType -> "eqref" + | AnyEqRefType -> "anyeqref" | AnyRefType -> "anyref" | AnyFuncType -> "anyfunc" diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index 31d3021d..bd67ea0a 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -446,6 +446,10 @@ let assertion mode ass = Node ("assert_return_canonical_nan", [action act]) | AssertReturnArithmeticNaN act -> Node ("assert_return_arithmetic_nan", [action act]) + | AssertReturnRef act -> + Node ("assert_return_ref", [action act]) + | AssertReturnFunc act -> + Node ("assert_return_func", [action act]) | AssertTrap (act, re) -> Node ("assert_trap", [action act; Atom (string re)]) | AssertExhaustion (act, re) -> diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 87059fe3..fefb13ea 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -160,8 +160,8 @@ rule token = parse | '"'character*'\\'_ { error_nest (Lexing.lexeme_end_p lexbuf) lexbuf "illegal escape" } - | "eqref" { EQREF } | "anyref" { ANYREF } + | "anyeqref" { ANYEQREF } | "anyfunc" { ANYFUNC } | (nxx as t) { NUM_TYPE (num_type t) } | "mut" { MUT } @@ -355,6 +355,8 @@ rule token = parse | "assert_return" { ASSERT_RETURN } | "assert_return_canonical_nan" { ASSERT_RETURN_CANONICAL_NAN } | "assert_return_arithmetic_nan" { ASSERT_RETURN_ARITHMETIC_NAN } + | "assert_return_ref" { ASSERT_RETURN_REF } + | "assert_return_func" { ASSERT_RETURN_FUNC } | "assert_trap" { ASSERT_TRAP } | "assert_exhaustion" { ASSERT_EXHAUSTION } | "input" { INPUT } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 1d48d110..13e646b1 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -147,7 +147,7 @@ let inline_type_explicit (c : context) x ft at = %token LPAR RPAR %token NAT INT FLOAT STRING VAR -%token EQREF ANYREF ANYFUNC NUM_TYPE MUT +%token ANYREF ANYEQREF ANYFUNC NUM_TYPE MUT %token NOP DROP BLOCK END IF THEN ELSE SELECT LOOP BR BR_IF BR_TABLE %token CALL CALL_INDIRECT RETURN %token GET_LOCAL SET_LOCAL TEE_LOCAL GET_GLOBAL SET_GLOBAL GET_TABLE SET_TABLE @@ -160,7 +160,8 @@ let inline_type_explicit (c : context) x ft at = %token MODULE BIN QUOTE %token SCRIPT REGISTER INVOKE GET %token ASSERT_MALFORMED ASSERT_INVALID ASSERT_SOFT_INVALID ASSERT_UNLINKABLE -%token ASSERT_RETURN ASSERT_RETURN_CANONICAL_NAN ASSERT_RETURN_ARITHMETIC_NAN ASSERT_TRAP ASSERT_EXHAUSTION +%token ASSERT_RETURN ASSERT_RETURN_CANONICAL_NAN ASSERT_RETURN_ARITHMETIC_NAN +%token ASSERT_RETURN_REF ASSERT_RETURN_FUNC ASSERT_TRAP ASSERT_EXHAUSTION %token INPUT OUTPUT %token EOF @@ -204,8 +205,8 @@ string_list : /* Types */ ref_type : - | EQREF { EqRefType } | ANYREF { AnyRefType } + | ANYEQREF { AnyEqRefType } | ANYFUNC { AnyFuncType } value_type : @@ -788,6 +789,8 @@ assertion : | LPAR ASSERT_RETURN action const_list RPAR { AssertReturn ($3, $4) @@ at () } | LPAR ASSERT_RETURN_CANONICAL_NAN action RPAR { AssertReturnCanonicalNaN $3 @@ at () } | LPAR ASSERT_RETURN_ARITHMETIC_NAN action RPAR { AssertReturnArithmeticNaN $3 @@ at () } + | LPAR ASSERT_RETURN_REF action RPAR { AssertReturnRef $3 @@ at () } + | LPAR ASSERT_RETURN_FUNC action RPAR { AssertReturnFunc $3 @@ at () } | LPAR ASSERT_TRAP action STRING RPAR { AssertTrap ($3, $4) @@ at () } | LPAR ASSERT_EXHAUSTION action STRING RPAR { AssertExhaustion ($3, $4) @@ at () } diff --git a/interpreter/util/lib.ml b/interpreter/util/lib.ml index 1be774ba..eac639d9 100644 --- a/interpreter/util/lib.ml +++ b/interpreter/util/lib.ml @@ -168,6 +168,11 @@ struct | Some y -> y | None -> x + let force o = + match o with + | Some y -> y + | None -> raise (Invalid_argument "Option.force") + let map f = function | Some x -> Some (f x) | None -> None diff --git a/interpreter/util/lib.mli b/interpreter/util/lib.mli index 5c3b8015..2789ad51 100644 --- a/interpreter/util/lib.mli +++ b/interpreter/util/lib.mli @@ -54,6 +54,7 @@ end module Option : sig val get : 'a option -> 'a -> 'a + val force : 'a option -> 'a (* raises Invalid_argument *) val map : ('a -> 'b) -> 'a option -> 'b option val app : ('a -> unit) -> 'a option -> unit end diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 62c85880..e0ff3e88 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -69,22 +69,29 @@ let string_of_infer_type t = let string_of_infer_types ts = "[" ^ String.concat " " (List.map string_of_infer_type ts) ^ "]" -let sub_ty t1 t2 = +let match_type t1 t2 = match t1, t2 with | Some t1, Some t2 -> match_value_type t1 t2 | _, _ -> true +let join_type t1 t2 = + match t1, t2 with + | _, None -> t1 + | None, _ -> t2 + | Some t1, Some t2 -> join_value_type t1 t2 + let check_stack ts1 ts2 at = - require (List.length ts1 = List.length ts2 && List.for_all2 sub_ty ts2 ts1) at - ("type mismatch: operator requires " ^ string_of_infer_types ts1 ^ - " but stack has " ^ string_of_infer_types ts2) + require + (List.length ts1 = List.length ts2 && List.for_all2 match_type ts1 ts2) at + ("type mismatch: operator requires " ^ string_of_infer_types ts2 ^ + " but stack has " ^ string_of_infer_types ts1) let pop (ell1, ts1) (ell2, ts2) at = let n1 = List.length ts1 in let n2 = List.length ts2 in let n = min n1 n2 in let n3 = if ell2 = Ellipses then (n1 - n) else 0 in - check_stack ts1 (Lib.List.make n3 None @ Lib.List.drop (n2 - n) ts2) at; + check_stack (Lib.List.make n3 None @ Lib.List.drop (n2 - n) ts2) ts1 at; (ell2, if ell1 = Ellipses then [] else Lib.List.take (n2 - n) ts2) let push (ell1, ts1) (ell2, ts2) = @@ -209,9 +216,13 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = (label c x @ [NumType I32Type]) --> label c x | BrTable (xs, x) -> - let ts = label c x in + let ts = + List.fold_left (fun t1 t2 -> Lib.Option.get (meet_stack_type t1 t2) t1) + (label c x) (List.map (label c) xs) + in + check_stack (known ts) (known (label c x)) x.at; List.iter (fun x' -> check_stack (known ts) (known (label c x')) x'.at) xs; - (label c x @ [NumType I32Type]) -->... [] + (ts @ [NumType I32Type]) -->... [] | Return -> c.results -->... [] @@ -232,7 +243,9 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = [peek 0 s] -~> [] | Select -> - let t = peek 1 s in + let t1 = peek 1 s in + let t2 = peek 0 s in + let t = join_type t1 t2 in [t; t; Some (NumType I32Type)] -~> [t] | GetLocal x -> @@ -284,7 +297,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = [RefType AnyRefType] --> [NumType I32Type] | Same -> - [RefType EqRefType; RefType EqRefType] --> [NumType I32Type] + [RefType AnyEqRefType; RefType AnyEqRefType] --> [NumType I32Type] | Const v -> let t = NumType (type_num v.it) in diff --git a/test/core/br_table.wast b/test/core/br_table.wast index 98608923..086c3c32 100644 --- a/test/core/br_table.wast +++ b/test/core/br_table.wast @@ -1228,6 +1228,43 @@ (i32.const 3) ) ) + + (func (export "meet-anyref") (param i32) (param anyref) (result anyref) + (block $l1 (result anyref) + (block $l2 (result anyref) + (br_table $l1 $l2 $l1 (get_local 1) (get_local 0)) + ) + ) + ) + + (func (export "meet-anyeqref") (param i32) (param anyeqref) (result anyref) + (block $l1 (result anyref) + (block $l2 (result anyeqref) + (br_table $l1 $l2 $l1 (get_local 1) (get_local 0)) + ) + ) + ) + + (func (export "meet-anyfunc") (param i32) (result anyref) + (block $l1 (result anyref) + (block $l2 (result anyfunc) + (br_table $l2 $l1 $l2 (get_table 0 (i32.const 0)) (get_local 0)) + ) + ) + ) + + (func (export "meet-nullref") (param i32) (result anyref) + (block $l1 (result anyref) + (block $l2 (result anyeqref) + (drop + (block $l3 (result anyfunc) + (br_table $l1 $l2 $l3 (ref.null) (get_local 0)) + ) + ) + (ref.null) + ) + ) + ) ) (assert_return (invoke "type-i32")) @@ -1409,6 +1446,22 @@ (assert_return (invoke "nested-br_table-loop-block" (i32.const 1)) (i32.const 3)) +(assert_return (invoke "meet-anyref" (i32.const 0) (ref.host 1)) (ref.host 1)) +(assert_return (invoke "meet-anyref" (i32.const 1) (ref.host 1)) (ref.host 1)) +(assert_return (invoke "meet-anyref" (i32.const 2) (ref.host 1)) (ref.host 1)) + +(assert_return (invoke "meet-anyeqref" (i32.const 0) (ref.host 1)) (ref.host 1)) +(assert_return (invoke "meet-anyeqref" (i32.const 1) (ref.host 1)) (ref.host 1)) +(assert_return (invoke "meet-anyeqref" (i32.const 2) (ref.host 1)) (ref.host 1)) + +(assert_return_func (invoke "meet-anyfunc" (i32.const 0))) +(assert_return_func (invoke "meet-anyfunc" (i32.const 1))) +(assert_return_func (invoke "meet-anyfunc" (i32.const 2))) + +(assert_return (invoke "meet-nullref" (i32.const 0)) (ref.null)) +(assert_return (invoke "meet-nullref" (i32.const 1)) (ref.null)) +(assert_return (invoke "meet-nullref" (i32.const 2)) (ref.null)) + (assert_invalid (module (func $type-arg-void-vs-num (result i32) (block (br_table 0 (i32.const 1)) (i32.const 1)) @@ -1475,6 +1528,20 @@ "type mismatch" ) +(assert_invalid + (module (func $meet-bottom (param i32) (result anyref) + (block $l1 (result anyref) + (drop + (block $l2 (result i32) + (br_table $l2 $l1 $l2 (ref.null) (get_local 0)) + ) + ) + (ref.null) + ) + )) + "type mismatch" +) + (assert_invalid (module (func $unbound-label (block (br_table 2 1 (i32.const 1))) diff --git a/test/core/select.wast b/test/core/select.wast index 4dfa4561..7d9a4ac0 100644 --- a/test/core/select.wast +++ b/test/core/select.wast @@ -1,4 +1,8 @@ (module + ;; Auxiliary + (func $dummy) + (table $tab anyfunc (elem $dummy)) + (func (export "select_i32") (param $lhs i32) (param $rhs i32) (param $cond i32) (result i32) (select (get_local $lhs) (get_local $rhs) (get_local $cond))) @@ -26,6 +30,22 @@ (unreachable) (f32.const 0) (i32.const 0) (select) (unreachable) ) + + (func (export "join-nullref") (param i32) (result anyref) + (select (ref.null) (ref.null) (get_local 0)) + ) + + (func (export "join-anyeqref") (param i32) (param anyeqref) (result anyref) + (select (get_local 1) (ref.null) (get_local 0)) + ) + + (func (export "join-anyfunc") (param i32) (result anyref) + (select (get_table $tab (i32.const 0)) (ref.null) (get_local 0)) + ) + + (func (export "join-anyref") (param i32) (param anyeqref) (result anyref) + (select (get_table $tab (i32.const 0)) (get_local 1) (get_local 0)) + ) ) (assert_return (invoke "select_i32" (i32.const 1) (i32.const 2) (i32.const 1)) (i32.const 1)) @@ -56,6 +76,18 @@ (assert_return (invoke "select_f64" (f64.const 2) (f64.const nan) (i32.const 0)) (f64.const nan)) (assert_return (invoke "select_f64" (f64.const 2) (f64.const nan:0x20304) (i32.const 0)) (f64.const nan:0x20304)) +(assert_return (invoke "join-nullref" (i32.const 1)) (ref.null)) +(assert_return (invoke "join-nullref" (i32.const 0)) (ref.null)) + +(assert_return (invoke "join-anyeqref" (i32.const 1) (ref.host 1)) (ref.host 1)) +(assert_return (invoke "join-anyeqref" (i32.const 0) (ref.host 1)) (ref.null)) + +(assert_return_func (invoke "join-anyfunc" (i32.const 1))) +(assert_return (invoke "join-anyfunc" (i32.const 0)) (ref.null)) + +(assert_return_func (invoke "join-anyref" (i32.const 1) (ref.host 1))) +(assert_return (invoke "join-anyref" (i32.const 0) (ref.host 1)) (ref.host 1)) + (assert_trap (invoke "select_trap_l" (i32.const 1)) "unreachable executed") (assert_trap (invoke "select_trap_l" (i32.const 0)) "unreachable executed") (assert_trap (invoke "select_trap_r" (i32.const 1)) "unreachable executed") From 89e6c90c8b2db99c782a1a2c88fba100b175cd67 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 23 Mar 2018 13:56:17 +0100 Subject: [PATCH 8/8] Tests for globals --- interpreter/syntax/types.ml | 5 +++-- test/core/globals.wast | 16 ++++++++++++++++ test/core/linking.wast | 17 +++++++++++++++++ 3 files changed, 36 insertions(+), 2 deletions(-) diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 45b262ce..39db555b 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -58,8 +58,9 @@ let match_table_type (TableType (lim1, et1)) (TableType (lim2, et2)) = let match_memory_type (MemoryType lim1) (MemoryType lim2) = match_limits lim1 lim2 -let match_global_type gt1 gt2 = - gt1 = gt2 +let match_global_type (GlobalType (t1, mut1)) (GlobalType (t2, mut2)) = + mut1 = mut2 && + (t1 = t2 || mut2 = Immutable && match_value_type t1 t2) let match_extern_type et1 et2 = match et1, et2 with diff --git a/test/core/globals.wast b/test/core/globals.wast index c4edfed3..5ce11544 100644 --- a/test/core/globals.wast +++ b/test/core/globals.wast @@ -11,12 +11,19 @@ (global (;6;) (mut f64) (f64.const -14)) (global $y (mut i64) (i64.const -15)) + (global $r anyref (ref.null)) + (global anyfunc (ref.null)) + (global $z (mut anyeqref) (ref.null)) + (func (export "get-a") (result i32) (get_global $a)) (func (export "get-b") (result i64) (get_global $b)) + (func (export "get-r") (result anyref) (get_global $r)) (func (export "get-x") (result i32) (get_global $x)) (func (export "get-y") (result i64) (get_global $y)) + (func (export "get-z") (result anyeqref) (get_global $z)) (func (export "set-x") (param i32) (set_global $x (get_local 0))) (func (export "set-y") (param i64) (set_global $y (get_local 0))) + (func (export "set-z") (param anyeqref) (set_global $z (get_local 0))) (func (export "get-1") (result f32) (get_global 1)) (func (export "get-2") (result f64) (get_global 2)) @@ -28,8 +35,10 @@ (assert_return (invoke "get-a") (i32.const -2)) (assert_return (invoke "get-b") (i64.const -5)) +(assert_return (invoke "get-r") (ref.null)) (assert_return (invoke "get-x") (i32.const -12)) (assert_return (invoke "get-y") (i64.const -15)) +(assert_return (invoke "get-z") (ref.null)) (assert_return (invoke "get-1") (f32.const -3)) (assert_return (invoke "get-2") (f64.const -4)) @@ -38,11 +47,13 @@ (assert_return (invoke "set-x" (i32.const 6))) (assert_return (invoke "set-y" (i64.const 7))) +(assert_return (invoke "set-z" (ref.host 33))) (assert_return (invoke "set-5" (f32.const 8))) (assert_return (invoke "set-6" (f64.const 9))) (assert_return (invoke "get-x") (i32.const 6)) (assert_return (invoke "get-y") (i64.const 7)) +(assert_return (invoke "get-z") (ref.host 33)) (assert_return (invoke "get-5") (f32.const 8)) (assert_return (invoke "get-6") (f64.const 9)) @@ -111,6 +122,11 @@ "type mismatch" ) +(assert_invalid + (module (global (import "" "") anyref) (global anyeqref (get_global 0))) + "type mismatch" +) + (assert_invalid (module (global i32 (get_global 0))) "unknown global" diff --git a/test/core/linking.wast b/test/core/linking.wast index 898d5a21..5f47ce67 100644 --- a/test/core/linking.wast +++ b/test/core/linking.wast @@ -58,6 +58,23 @@ (assert_return (invoke $Ng "Mg.get") (i32.const 42)) (assert_return (invoke $Ng "get") (i32.const 43)) +(module $Mref-ex + (global (export "g-const") anyeqref (ref.null)) + ;; Mutable globals cannot be exported yet + ;; (global (export "g-var") (mut anyeqref) (ref.null)) +) +(register "Mref-ex" $Mref-ex) + +(module $Mref-im + (global (import "Mref-ex" "g-const") anyref) +) + +;; Mutable globals cannot be imported yet +;;(assert_unlinkable +;; (module (global (import "Mref-ex" "g-var") (mut anyref))) +;; "type mismatch" +;;) + ;; Tables