[Interpreter] infrastructure

interpreter/binary/encode.ml

@@ -95,6 +95,7 @@ let encode m =
       | I64Type -> vs7 (-0x02)
       | F32Type -> vs7 (-0x03)
       | F64Type -> vs7 (-0x04)
+      | V128Type -> failwith "TODO v128"
 
     let elem_type = function
       | FuncRefType -> vs7 (-0x10)
@@ -195,6 +196,10 @@ let encode m =
         op 0x35; memop mo
       | Load {ty = F32Type | F64Type; sz = Some _; _} ->
         assert false
+      | Load {ty = V128Type; sz = None; _} ->
+        failwith "TODO v128"
+      | Load {ty = V128Type; sz = Some _; _} ->
+        failwith "TODO v128"
 
       | Store ({ty = I32Type; sz = None; _} as mo) -> op 0x36; memop mo
       | Store ({ty = I64Type; sz = None; _} as mo) -> op 0x37; memop mo
@@ -207,6 +212,10 @@ let encode m =
       | Store ({ty = I64Type; sz = Some Pack16; _} as mo) -> op 0x3d; memop mo
       | Store ({ty = I64Type; sz = Some Pack32; _} as mo) -> op 0x3e; memop mo
       | Store {ty = F32Type | F64Type; sz = Some _; _} -> assert false
+      | Store {ty = V128Type; sz = None; _} ->
+        failwith "TODO v128"
+      | Store {ty = V128Type; sz = Some _; _} ->
+        failwith "TODO v128"
 
       | MemorySize -> op 0x3f; u8 0x00
       | MemoryGrow -> op 0x40; u8 0x00
@@ -215,11 +224,14 @@ let encode m =
       | Const {it = I64 c; _} -> op 0x42; vs64 c
       | Const {it = F32 c; _} -> op 0x43; f32 c
       | Const {it = F64 c; _} -> op 0x44; f64 c
+      | Const {it = V128 c; _} ->
+        failwith "TODO v128"
 
       | Test (I32 I32Op.Eqz) -> op 0x45
       | Test (I64 I64Op.Eqz) -> op 0x50
       | Test (F32 _) -> assert false
       | Test (F64 _) -> assert false
+      | Test (V128 _) -> assert false
 
       | Compare (I32 I32Op.Eq) -> op 0x46
       | Compare (I32 I32Op.Ne) -> op 0x47
@@ -256,6 +268,7 @@ let encode m =
       | Compare (F64 F64Op.Gt) -> op 0x64
       | Compare (F64 F64Op.Le) -> op 0x65
       | Compare (F64 F64Op.Ge) -> op 0x66
+      | Compare (V128 _) -> failwith "TODO v128"
 
       | Unary (I32 I32Op.Clz) -> op 0x67
       | Unary (I32 I32Op.Ctz) -> op 0x68
@@ -280,6 +293,7 @@ let encode m =
       | Unary (F64 F64Op.Trunc) -> op 0x9d
       | Unary (F64 F64Op.Nearest) -> op 0x9e
       | Unary (F64 F64Op.Sqrt) -> op 0x9f
+      | Unary (V128 _) -> failwith "TODO v128"
 
       | Binary (I32 I32Op.Add) -> op 0x6a
       | Binary (I32 I32Op.Sub) -> op 0x6b
@@ -328,6 +342,7 @@ let encode m =
       | Binary (F64 F64Op.Min) -> op 0xa4
       | Binary (F64 F64Op.Max) -> op 0xa5
       | Binary (F64 F64Op.CopySign) -> op 0xa6
+      | Binary (V128 _) -> failwith "TODO v128"
 
       | Convert (I32 I32Op.ExtendSI32) -> assert false
       | Convert (I32 I32Op.ExtendUI32) -> assert false
@@ -362,6 +377,7 @@ let encode m =
       | Convert (F64 F64Op.PromoteF32) -> op 0xbb
       | Convert (F64 F64Op.DemoteF64) -> assert false
       | Convert (F64 F64Op.ReinterpretInt) -> op 0xbf
+      | Convert (V128 _) -> failwith "TODO v128"
 
     let const c =
       list instr c.it; end_ ()

interpreter/exec/eval_numeric.ml

@@ -116,6 +116,31 @@ end
 module F32Op = FloatOp (F32) (Values.F32Value)
 module F64Op = FloatOp (F64) (Values.F64Value)
 
+(* Vector operators *)
+
+module VectorOp (VXX : Vector.S) (Value : ValueType with type t = VXX.t) =
+struct
+  (* TODO
+  open Ast.VectorOp
+
+  let to_value = Value.to_value
+  let of_value = of_arg Value.of_value
+  *)
+
+  (* FIXME *)
+  let unop op = failwith "TODO v128"
+
+  (* FIXME *)
+  let binop op = failwith "TODO v128"
+
+  (* FIXME *)
+  let testop op = failwith "TODO v128"
+
+  (* FIXME *)
+  let relop op = failwith "TODO v128"
+end
+
+module V128Op = VectorOp (V128) (Values.V128Value)
 
 (* Conversion operators *)
 
@@ -181,17 +206,28 @@ struct
     | DemoteF64 -> raise (TypeError (1, v, F64Type))
 end
 
+module V128CvtOp =
+struct
+  (* TODO
+  open Ast.VectorOp
+  *)
+
+  (* FIXME *)
+  let cvtop op v = failwith "TODO v128"
+end
+
 
 (* Dispatch *)
 
-let op i32 i64 f32 f64 = function
+let op i32 i64 f32 f64 v128 = function
   | I32 x -> i32 x
   | I64 x -> i64 x
   | F32 x -> f32 x
   | F64 x -> f64 x
+  | V128 x -> v128 x
 
-let eval_unop = op I32Op.unop I64Op.unop F32Op.unop F64Op.unop
-let eval_binop = op I32Op.binop I64Op.binop F32Op.binop F64Op.binop
-let eval_testop = op I32Op.testop I64Op.testop F32Op.testop F64Op.testop
-let eval_relop = op I32Op.relop I64Op.relop F32Op.relop F64Op.relop
-let eval_cvtop = op I32CvtOp.cvtop I64CvtOp.cvtop F32CvtOp.cvtop F64CvtOp.cvtop
+let eval_unop = op I32Op.unop I64Op.unop F32Op.unop F64Op.unop V128Op.unop
+let eval_binop = op I32Op.binop I64Op.binop F32Op.binop F64Op.binop V128Op.binop
+let eval_testop = op I32Op.testop I64Op.testop F32Op.testop F64Op.testop V128Op.testop
+let eval_relop = op I32Op.relop I64Op.relop F32Op.relop F64Op.relop V128Op.relop
+let eval_cvtop = op I32CvtOp.cvtop I64CvtOp.cvtop F32CvtOp.cvtop F64CvtOp.cvtop V128CvtOp.cvtop

interpreter/exec/v128.ml

@@ -0,0 +1,5 @@
+include Vector.Make
+  (struct
+    include Bytes
+    let bytewidth = 16
+  end)

interpreter/exec/vector.ml

@@ -0,0 +1,30 @@
+open Char
+
+module type RepType =
+sig
+  type t
+
+  val make : int -> char -> t
+  (* ^ bits_make ? *)
+  val to_string : t -> string
+  val bytewidth : int
+end
+
+module type S =
+sig
+  type t
+  type bits
+  val default : t (* FIXME good name for default value? *)
+  val to_string : t -> string
+  val to_bits : t -> bits
+end
+
+module Make (Rep : RepType) : S with type bits = Rep.t =
+struct
+  type t = Rep.t
+  type bits = Rep.t
+
+  let default = Rep.make Rep.bytewidth (chr 0)
+  let to_string = Rep.to_string (* FIXME very very wrong *)
+  let to_bits x = x
+end

interpreter/host/spectest.ml

@@ -14,6 +14,7 @@ let global (GlobalType (t, _) as gt) =
     | I64Type -> I64 666L
     | F32Type -> F32 (F32.of_float 666.6)
     | F64Type -> F64 (F64.of_float 666.6)
+    | V128Type -> failwith "TODO v128"
   in Global.alloc gt v
 
 let table = Table.alloc (TableType ({min = 10l; max = Some 20l}, FuncRefType))

interpreter/runtime/memory.ml

@@ -111,6 +111,7 @@ let load_value mem a o t =
   | I64Type -> I64 n
   | F32Type -> F32 (F32.of_bits (Int64.to_int32 n))
   | F64Type -> F64 (F64.of_bits n)
+  | V128Type -> failwith "TODO v128"
 
 let store_value mem a o v =
   let x =
@@ -119,6 +120,7 @@ let store_value mem a o v =
     | I64 x -> x
     | F32 x -> Int64.of_int32 (F32.to_bits x)
     | F64 x -> F64.to_bits x
+    | V128 x -> failwith "TODO v128" (* FIXME V128.to_bits x requires store to accept something other than int64 *)
   in storen mem a o (Types.size (Values.type_of v)) x
 
 let extend x n = function

interpreter/script/js.ml

@@ -191,24 +191,29 @@ let eq_of = function
   | I64Type -> Values.I64 I64Op.Eq
   | F32Type -> Values.F32 F32Op.Eq
   | F64Type -> Values.F64 F64Op.Eq
+  | V128Type -> failwith "TODO v128"
 
 let and_of = function
   | I32Type | F32Type -> Values.I32 I32Op.And
   | I64Type | F64Type -> Values.I64 I64Op.And
+  | V128Type -> failwith "TODO v128"
 
 let reinterpret_of = function
   | I32Type -> I32Type, Nop
   | I64Type -> I64Type, Nop
   | F32Type -> I32Type, Convert (Values.I32 I32Op.ReinterpretFloat)
   | F64Type -> I64Type, Convert (Values.I64 I64Op.ReinterpretFloat)
+  | V128Type -> failwith "TODO v128"
 
 let canonical_nan_of = function
   | I32Type | F32Type -> Values.I32 (F32.to_bits F32.pos_nan)
   | I64Type | F64Type -> Values.I64 (F64.to_bits F64.pos_nan)
+  | V128Type -> failwith "TODO v128"
 
 let abs_mask_of = function
   | I32Type | F32Type -> Values.I32 Int32.max_int
   | I64Type | F64Type -> Values.I64 Int64.max_int
+  | V128Type -> failwith "TODO v128"
 
 let invoke ft lits at =
   [ft @@ at], FuncImport (1l @@ at) @@ at,
@@ -270,7 +275,7 @@ let wrap module_name item_name wrap_action wrap_assertion at =
 
 let is_js_value_type = function
   | I32Type -> true
-  | I64Type | F32Type | F64Type -> false
+  | I64Type | F32Type | F64Type | V128Type -> false
 
 let is_js_global_type = function
   | GlobalType (t, mut) -> is_js_value_type t && mut = Immutable
@@ -320,6 +325,7 @@ let of_literal lit =
   | 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)
+  | Values.V128 v -> failwith "TODO v128" (* FIXME should this be even valid *)
 
 let rec of_definition def =
   match def.it with

interpreter/syntax/ast.ml

@@ -44,16 +44,27 @@ struct
              | ReinterpretInt
 end
 
+(* FIXME *)
+module VectorOp =
+struct
+  type unop = TodoUnOp
+  type binop = TodoBinOp
+  type testop = TodoTestOp
+  type relop = TodoRelOp
+  type cvtop = TodoCvtOp
+end
+
 module I32Op = IntOp
 module I64Op = IntOp
 module F32Op = FloatOp
 module F64Op = FloatOp
+module V128Op = VectorOp
 
-type unop = (I32Op.unop, I64Op.unop, F32Op.unop, F64Op.unop) Values.op
-type binop = (I32Op.binop, I64Op.binop, F32Op.binop, F64Op.binop) Values.op
-type testop = (I32Op.testop, I64Op.testop, F32Op.testop, F64Op.testop) Values.op
-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 unop = (I32Op.unop, I64Op.unop, F32Op.unop, F64Op.unop, V128Op.unop) Values.op
+type binop = (I32Op.binop, I64Op.binop, F32Op.binop, F64Op.binop, V128Op.binop) Values.op
+type testop = (I32Op.testop, I64Op.testop, F32Op.testop, F64Op.testop, V128Op.testop) Values.op
+type relop = (I32Op.relop, I64Op.relop, F32Op.relop, F64Op.relop, V128Op.relop) Values.op
+type cvtop = (I32Op.cvtop, I64Op.cvtop, F32Op.cvtop, F64Op.cvtop, V128Op.cvtop) Values.op
 
 type 'a memop =
   {ty : value_type; align : int; offset : Memory.offset; sz : 'a option}

interpreter/syntax/types.ml

@@ -1,6 +1,6 @@
 (* Types *)
 
-type value_type = I32Type | I64Type | F32Type | F64Type
+type value_type = I32Type | I64Type | F32Type | F64Type | V128Type
 type elem_type = FuncRefType
 type stack_type = value_type list
 type func_type = FuncType of stack_type * stack_type
@@ -22,6 +22,7 @@ type extern_type =
 let size = function
   | I32Type | F32Type -> 4
   | I64Type | F64Type -> 8
+  | V128Type -> 16
 
 
 (* Subtyping *)
@@ -73,6 +74,7 @@ let string_of_value_type = function
   | I64Type -> "i64"
   | F32Type -> "f32"
   | F64Type -> "f64"
+  | V128Type -> "v128"
 
 let string_of_value_types = function
   | [t] -> string_of_value_type t

interpreter/syntax/values.ml

@@ -3,10 +3,10 @@ open Types
 
 (* Values and operators *)
 
-type ('i32, 'i64, 'f32, 'f64) op =
-  I32 of 'i32 | I64 of 'i64 | F32 of 'f32 | F64 of 'f64
+type ('i32, 'i64, 'f32, 'f64, 'v128) op =
+  I32 of 'i32 | I64 of 'i64 | F32 of 'f32 | F64 of 'f64 | V128 of 'v128
 
-type value = (I32.t, I64.t, F32.t, F64.t) op
+type value = (I32.t, I64.t, F32.t, F64.t, V128.t) op
 
 
 (* Typing *)
@@ -16,12 +16,14 @@ let type_of = function
   | I64 _ -> I64Type
   | F32 _ -> F32Type
   | F64 _ -> F64Type
+  | V128 _ -> V128Type
 
 let default_value = function
   | I32Type -> I32 I32.zero
   | I64Type -> I64 I64.zero
   | F32Type -> F32 F32.zero
   | F64Type -> F64 F64.zero
+  | V128Type -> V128 V128.default
 
 
 (* Conversion *)
@@ -33,6 +35,7 @@ let string_of_value = function
   | I64 i -> I64.to_string_s i
   | F32 z -> F32.to_string z
   | F64 z -> F64.to_string z
+  | V128 v -> V128.to_string v
 
 let string_of_values = function
   | [v] -> string_of_value v
@@ -77,3 +80,10 @@ struct
   let to_value i = F64 i
   let of_value = function F64 z -> z | _ -> raise (Value F64Type)
 end
+
+module V128Value =
+struct
+  type t = V128.t
+  let to_value i = V128 i
+  let of_value = function V128 z -> z | _ -> raise (Value V128Type)
+end