Implement SIMD load splat and load extend

interpreter/binary/encode.ml

@@ -200,6 +200,8 @@ let encode m =
       | Load ({ty = V128Type; _} as mo) ->
         simd_op 0x00l; memop mo
 
+      | SimdLoad _ -> failwith "TODO v128 SimdLoad"
+
       | Store ({ty = I32Type; sz = None; _} as mo) -> op 0x36; memop mo
       | Store ({ty = I64Type; sz = None; _} as mo) -> op 0x37; memop mo
       | Store ({ty = F32Type; sz = None; _} as mo) -> op 0x38; memop mo

interpreter/exec/eval.ml

@@ -220,6 +220,17 @@ let rec step (c : config) : config =
           in v :: vs', []
         with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at])
 
+      | SimdLoad {offset; ty; sz; _}, I32 i :: vs' ->
+        let mem = memory frame.inst (0l @@ e.at) in
+        let addr = I64_convert.extend_i32_u i in
+        (try
+          let v =
+            match sz with
+            | None -> assert false
+            | Some load_kind -> Memory.load_simd load_kind mem addr offset ty
+          in v :: vs', []
+        with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at])
+
       | Store {offset; sz; _}, v :: I32 i :: vs' ->
         let mem = memory frame.inst (0l @@ e.at) in
         let addr = I64_convert.extend_i32_u i in

interpreter/exec/simd.ml

@@ -173,6 +173,10 @@ sig
     val widen_low_u : t -> t
     val widen_high_u : t -> t
   end
+  module I64x2_convert : sig
+    val widen_low_s : t -> t
+    val widen_low_u : t -> t
+  end
   module F32x4_convert : sig
     val convert_i32x4_s : t -> t
     val convert_i32x4_u : t -> t
@@ -395,6 +399,16 @@ struct
     let widen_high_u = widen Lib.List.drop 0xffffl
   end
 
+  module I64x2_convert = struct
+    let widen mask x =
+      Rep.of_i64x2
+        (List.map
+           (fun i32 -> Int64.(logand mask (of_int32 i32)))
+           (Lib.List.take 2 (Rep.to_i32x4 x)))
+    let widen_low_s = widen 0xffffffffffffffffL
+    let widen_low_u = widen 0xffffffffL
+  end
+
   module F32x4_convert = struct
     let convert f v = Rep.of_f32x4 (List.map f (Rep.to_i32x4 v))
     let convert_i32x4_s = convert F32_convert.convert_i32_s

interpreter/runtime/memory.ml

@@ -131,6 +131,28 @@ let load_packed sz ext mem a o t =
   | I64Type -> I64 x
   | _ -> raise Type
 
+let load_simd load_kind mem a o t =
+  let n = match load_kind with
+  | LoadSplat sz -> simd_packed_size sz
+  | LoadExtend (sz, ext) -> 8
+  in
+  assert (n <= Types.size t);
+  let x = (loadn mem a o n) in
+  let b = Bytes.create 16 in
+  Bytes.set_int64_le b 0 x;
+  let v = V128.of_bits (Bytes.to_string b) in
+  match load_kind with
+  | LoadExtend (SimdPack8, SX) -> V128 (V128.I16x8_convert.widen_low_s v)
+  | LoadExtend (SimdPack8, ZX) -> V128 (V128.I16x8_convert.widen_low_u v)
+  | LoadExtend (SimdPack16, SX) -> V128 (V128.I32x4_convert.widen_low_s v)
+  | LoadExtend (SimdPack16, ZX) -> V128 (V128.I32x4_convert.widen_low_u v)
+  | LoadExtend (SimdPack32, SX) -> V128 (V128.I64x2_convert.widen_low_s v)
+  | LoadExtend (SimdPack32, ZX) -> V128 (V128.I64x2_convert.widen_low_u v)
+  | LoadSplat (SimdPack8) -> V128 (V128.I8x16.splat (I8.of_int_s (Int64.to_int x)))
+  | LoadSplat (SimdPack16) -> V128 (V128.I16x8.splat (I16.of_int_s (Int64.to_int x)))
+  | LoadSplat (SimdPack32) -> V128 (V128.I32x4.splat (I32.of_int_s (Int64.to_int x)))
+  | _ -> assert false
+
 let store_packed sz mem a o v =
   assert (packed_size sz <= Types.size (Values.type_of v));
   let n = packed_size sz in

interpreter/runtime/memory.mli

@@ -35,6 +35,9 @@ val store_value :
 val load_packed :
   pack_size -> extension -> memory -> address -> offset -> value_type -> value
     (* raises Type, Bounds *)
+val load_simd :
+  simd_load_kind -> memory -> address -> offset -> value_type -> value
+    (* raises Type, Bounds *)
 val store_packed :
   pack_size -> memory -> address -> offset -> value -> unit
     (* raises Type, Bounds *)

interpreter/syntax/ast.ml

@@ -107,6 +107,7 @@ type 'a memop =
   {ty : value_type; align : int; offset : Memory.offset; sz : 'a option}
 type loadop = (pack_size * extension) memop
 type storeop = pack_size memop
+type simdloadop = simd_load_kind memop
 
 
 (* Expressions *)
@@ -138,6 +139,7 @@ and instr' =
   | GlobalGet of var                  (* read global variable *)
   | GlobalSet of var                  (* write global variable *)
   | Load of loadop                    (* read memory at address *)
+  | SimdLoad of simdloadop            (* read memory at address *)
   | Store of storeop                  (* write memory at address *)
   | MemorySize                        (* size of linear memory *)
   | MemoryGrow                        (* grow linear memory *)

interpreter/syntax/operators.ml

@@ -229,6 +229,30 @@ let v128_bitselect = Ternary (V128Op.Bitselect)
 let v8x16_swizzle = Binary (V128 V128Op.(I8x16 Swizzle))
 let v8x16_shuffle imms = Binary (V128 V128Op.(I8x16 (Shuffle imms)))
 
+let i16x8_load8x8_s align offset =
+  SimdLoad {ty = V128Type; align; offset; sz = Some (LoadExtend (SimdPack8, SX))}
+let i16x8_load8x8_u align offset =
+  SimdLoad {ty = V128Type; align; offset; sz = Some (LoadExtend (SimdPack8, ZX))}
+
+let i32x4_load16x4_s align offset =
+  SimdLoad {ty = V128Type; align; offset; sz = Some (LoadExtend (SimdPack16, SX))}
+let i32x4_load16x4_u align offset =
+  SimdLoad {ty = V128Type; align; offset; sz = Some (LoadExtend (SimdPack16, ZX))}
+
+let i64x2_load32x2_s align offset =
+  SimdLoad {ty = V128Type; align; offset; sz = Some (LoadExtend (SimdPack32, SX))}
+let i64x2_load32x2_u align offset =
+  SimdLoad {ty = V128Type; align; offset; sz = Some (LoadExtend (SimdPack32, ZX))}
+
+let v8x16_load_splat align offset =
+  SimdLoad {ty= V128Type; align; offset; sz = Some (LoadSplat SimdPack8)}
+let v16x8_load_splat align offset =
+  SimdLoad {ty= V128Type; align; offset; sz = Some (LoadSplat SimdPack16)}
+let v32x4_load_splat align offset =
+  SimdLoad {ty= V128Type; align; offset; sz = Some (LoadSplat SimdPack32)}
+let v64x2_load_splat align offset =
+  SimdLoad {ty= V128Type; align; offset; sz = Some (LoadSplat SimdPack64)}
+
 let i8x16_splat = Convert (V128 (V128Op.I8x16 V128Op.Splat))
 let i8x16_extract_lane_s imm = SimdExtract (V128Op.I8x16 (SX, imm))
 let i8x16_extract_lane_u imm = SimdExtract (V128Op.I8x16 (ZX, imm))

interpreter/syntax/types.ml

@@ -19,6 +19,12 @@ type extern_type =
 type pack_size = Pack8 | Pack16 | Pack32
 type extension = SX | ZX
 
+type simd_pack_size =
+  | SimdPack8 | SimdPack16 | SimdPack32 | SimdPack64
+type simd_load_kind =
+    LoadSplat of simd_pack_size
+  | LoadExtend of simd_pack_size * extension
+
 
 (* Attributes *)
 
@@ -32,6 +38,11 @@ let packed_size = function
   | Pack16 -> 2
   | Pack32 -> 4
 
+let simd_packed_size = function
+  | SimdPack8 -> 1
+  | SimdPack16 -> 2
+  | SimdPack32 -> 4
+  | SimdPack64 -> 8
 
 (* Subtyping *)
 

interpreter/text/arrange.ml

@@ -321,6 +321,7 @@ let rec instr e =
     | SimdExtract op -> failwith "TODO v128"
     | SimdReplace op -> failwith "TODO v128"
     | SimdShift op -> failwith "TODO v128"
+    | SimdLoad _ -> failwith "TODO v128 SimdLoad"
   in Node (head, inner)
 
 let const c =

interpreter/text/lexer.mll

@@ -288,6 +288,20 @@ rule token = parse
             (ext s i64_load8_s i64_load8_u (opt a 0))
             (ext s i64_load16_s i64_load16_u (opt a 1))
             (ext s i64_load32_s i64_load32_u (opt a 2)) o)) }
+  | "i16x8.load8x8_"(sign as s)
+  { LOAD (fun a o -> (ext s i16x8_load8x8_s i16x8_load8x8_u (opt a 3)) o) }
+  | "i32x4.load16x4_"(sign as s)
+  { LOAD (fun a o -> (ext s i32x4_load16x4_s i32x4_load16x4_u (opt a 3)) o) }
+  | "i64x2.load32x2_"(sign as s)
+  { LOAD (fun a o -> (ext s i64x2_load32x2_s i64x2_load32x2_u (opt a 3)) o) }
+  | "v8x16.load_splat"
+  { LOAD (fun a o -> (v8x16_load_splat (opt a 0)) o) }
+  | "v16x8.load_splat"
+  { LOAD (fun a o -> (v16x8_load_splat (opt a 1)) o) }
+  | "v32x4.load_splat"
+  { LOAD (fun a o -> (v32x4_load_splat (opt a 2)) o) }
+  | "v64x2.load_splat"
+  { LOAD (fun a o -> (v64x2_load_splat (opt a 3)) o) }
   | (ixx as t)".store"(mem_size as sz)
     { if t = "i32" && sz = "32" then error lexbuf "unknown operator";
       STORE (fun a o ->

interpreter/valid/valid.ml

@@ -201,6 +201,17 @@ let check_simd_extract_lane_index op at =
 let check_simd_replace_lane_index op at =
   check_simd_lane_index Fun.id op at
 
+let check_simd_memop (c : context) (memop : 'a memop) at =
+  ignore (memory c (0l @@ at));
+  let size =
+    match memop.sz with
+    | Some (LoadExtend _) -> 8
+    | Some (LoadSplat sz) -> simd_packed_size sz
+    | _ -> size memop.ty
+  in
+  require (1 lsl memop.align <= size) at
+    "alignment must not be larger than natural"
+
 (*
  * Conventions:
  *   c  : context
@@ -303,6 +314,10 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type =
     check_memop c memop (Lib.Option.map fst) e.at;
     [I32Type] --> [memop.ty]
 
+  | SimdLoad memop ->
+    check_simd_memop c memop e.at;
+    [I32Type] --> [memop.ty]
+
   | Store memop ->
     check_memop c memop (fun sz -> sz) e.at;
     [I32Type; memop.ty] --> []