Merge pull request #363 from WebAssembly/array_bulk_1

bulk array op interpreter implementations
WebAssembly · May 16, 2023 · afa3e66 · afa3e66
2 parents 1fd0fbe + 8091000
commit afa3e66
Show file tree

Hide file tree

Showing 15 changed files with 671 additions and 18 deletions.
diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml
@@ -605,6 +605,11 @@ let rec instr s =
     | 0x16l -> array_set (at var s)
     | 0x17l -> array_len
 
+    | 0x18l -> let x = at var s in let y = at var s in array_copy x y
+    | 0x0fl -> array_fill (at var s)
+    | 0x54l -> let x = at var s in let y = at var s in array_init_data x y
+    | 0x55l -> let x = at var s in let y = at var s in array_init_elem x y
+
     | 0x19l -> let x = at var s in let n = u32 s in array_new_fixed x n
     | 0x1bl -> let x = at var s in let y = at var s in array_new_data x y
     | 0x1cl -> let x = at var s in let y = at var s in array_new_elem x y

diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml
@@ -407,6 +407,11 @@ struct
     | ArraySet x -> op 0xfb; op 0x16; var x
     | ArrayLen -> op 0xfb; op 0x17
 
+    | ArrayCopy (x, y) -> op 0xfb; op 0x18; var x; var y
+    | ArrayFill x -> op 0xfb; op 0x0f; var x
+    | ArrayInitData (x, y) -> op 0xfb; op 0x54; var x; var y
+    | ArrayInitElem (x, y) -> op 0xfb; op 0x55; var x; var y
+
     | ExternConvert Internalize -> op 0xfb; op 0x70
     | ExternConvert Externalize -> op 0xfb; op 0x71
 

diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml
@@ -80,6 +80,12 @@ let config inst vs es =
 
 let plain e = Plain e.it @@ e.at
 
+let admin_instr_of_value (v : value) at : admin_instr' =
+  match v with
+  | Num n -> Plain (Const (n @@ at))
+  | Vec v -> Plain (VecConst (v @@ at))
+  | Ref r -> Refer r
+
 let is_jumping e =
   match e.it with
   | Trapping _ | Returning _ | ReturningInvoke _ | Breaking _ -> true
@@ -133,6 +139,26 @@ let drop n (vs : 'a stack) at =
 
 let split n (vs : 'a stack) at = take n vs at, drop n vs at
 
+let value_of_data_ind (seg : Data.data) (st : storage_type) (j : int) at =
+  let bs = Data.bytes seg in
+  match st with
+    | PackStorageT Pack.Pack8 ->
+      Num (I32 (I32.of_int_u (String.get_uint8 bs j)))
+    | PackStorageT Pack.Pack16 ->
+      Num (I32 (I32.of_int_u (String.get_uint16_le bs j)))
+    | ValStorageT (NumT I32T) ->
+      Num (I32 (String.get_int32_le bs j))
+    | ValStorageT (NumT I64T) ->
+      Num (I64 (String.get_int64_le bs j))
+    | ValStorageT (NumT F32T) ->
+      Num (F32 (F32.of_bits (String.get_int32_le bs j)))
+    | ValStorageT (NumT F64T) ->
+      Num (F64 (F64.of_bits (String.get_int64_le bs j)))
+    | ValStorageT (VecT V128T) ->
+      Vec (V128 (V128.of_bits (String.sub bs j 16)))
+    | _ ->
+      Crash.error at "type mismatch packing value"
+
 
 (* Evaluation *)
 
@@ -161,6 +187,10 @@ let elem_oob frame x i n =
   I64.gt_u (I64.add (I64_convert.extend_i32_u i) (I64_convert.extend_i32_u n))
     (I64_convert.extend_i32_u (Elem.size (elem frame.inst x)))
 
+let array_oob x i n =
+  I64.gt_u (I64.add (I64_convert.extend_i32_u i) (I64_convert.extend_i32_u n))
+    (I64_convert.extend_i32_u (Lib.List32.length x))
+
 let rec step (c : config) : config =
   let vs, es = c.code in
   let e = List.hd es in
@@ -686,27 +716,10 @@ let rec step (c : config) : config =
         else
           let ArrayT (FieldT (_mut, st)) = array_type c.frame.inst x in
           let seg = data c.frame.inst y in
-          let bs = Data.bytes seg in
           let args = Lib.List32.init n
             (fun i ->
               let j = I32.to_int_u s + I32.to_int_u i * storage_size st in
-              match st with
-              | PackStorageT Pack.Pack8 ->
-                Num (I32 (I32.of_int_u (String.get_uint8 bs j)))
-              | PackStorageT Pack.Pack16 ->
-                Num (I32 (I32.of_int_u (String.get_uint16_le bs j)))
-              | ValStorageT (NumT I32T) ->
-                Num (I32 (String.get_int32_le bs j))
-              | ValStorageT (NumT I64T) ->
-                Num (I64 (String.get_int64_le bs j))
-              | ValStorageT (NumT F32T) ->
-                Num (F32 (F32.of_bits (String.get_int32_le bs j)))
-              | ValStorageT (NumT F64T) ->
-                Num (F64 (F64.of_bits (String.get_int64_le bs j)))
-              | ValStorageT (VecT V128T) ->
-                Vec (V128 (V128.of_bits (String.sub bs j 16)))
-              | _ ->
-                Crash.error e.at "type mismatch packing value"
+              value_of_data_ind seg st j e.at
             )
           in
           let array =
@@ -742,6 +755,140 @@ let rec step (c : config) : config =
       | ArrayLen, Ref Aggr.(ArrayRef (Array (_, fs))) :: vs' ->
         Num (I32 (Lib.List32.length fs)) :: vs', []
 
+      | ArrayCopy (x, y),
+        Num _ :: Num _ :: Ref (NullRef _) :: Num _ :: Ref _ :: vs' ->
+        vs', [Trapping "null array reference" @@ e.at]
+
+      | ArrayCopy (x, y),
+        Num _ :: Num _ :: Ref _ :: Num _ :: Ref (NullRef _) :: vs' ->
+        vs', [Trapping "null array reference" @@ e.at]
+
+      | ArrayCopy (x, y),
+        Num (I32 n) ::
+          Num (I32 s) :: Ref Aggr.(ArrayRef (Array (ts, fss))) ::
+          Num (I32 d) :: Ref Aggr.(ArrayRef (Array (td, fsd))) :: vs' ->
+        if array_oob fss s n || array_oob fsd d n then
+          vs', [Trapping "out of bounds array access" @@ e.at]
+        else if n = 0l then
+          vs', []
+        else let exto =
+          match as_array_str_type (expand_def_type (Aggr.(type_of_array (Array (ts, fss))))) with
+            | ArrayT (FieldT (_, st)) -> if is_packed_storage_type st then Some ZX else None
+        in
+        if I32.le_u d s then
+          vs', List.map (Lib.Fun.flip (@@) e.at) [
+            Refer (Aggr.(ArrayRef (Array (td, fsd))));
+            Plain (Const (I32 d @@ e.at));
+            Refer (Aggr.(ArrayRef (Array (ts, fss))));
+            Plain (Const (I32 s @@ e.at));
+            Plain (ArrayGet (y, exto));
+            Plain (ArraySet x);
+            Refer (Aggr.(ArrayRef (Array (td, fsd))));
+            Plain (Const (I32 (I32.add d 1l) @@ e.at));
+            Refer (Aggr.(ArrayRef (Array (ts, fss))));
+            Plain (Const (I32 (I32.add s 1l) @@ e.at));
+            Plain (Const (I32 (I32.sub n 1l) @@ e.at));
+            Plain (ArrayCopy (x, y));
+          ]
+        else (* d > s *)
+          vs', List.map (Lib.Fun.flip (@@) e.at) [
+            Refer (Aggr.(ArrayRef (Array (td, fsd))));
+            Plain (Const (I32 (I32.add d 1l) @@ e.at));
+            Refer (Aggr.(ArrayRef (Array (ts, fss))));
+            Plain (Const (I32 (I32.add s 1l) @@ e.at));
+            Plain (Const (I32 (I32.sub n 1l) @@ e.at));
+            Plain (ArrayCopy (x, y));
+            Refer (Aggr.(ArrayRef (Array (td, fsd))));
+            Plain (Const (I32 d @@ e.at));
+            Refer (Aggr.(ArrayRef (Array (ts, fss))));
+            Plain (Const (I32 s @@ e.at));
+            Plain (ArrayGet (y, exto));
+            Plain (ArraySet x);
+          ]
+
+      | ArrayFill x, Num (I32 n) :: v :: Num (I32 i) :: Ref (NullRef _) :: vs' ->
+        vs', [Trapping "null array reference" @@ e.at]
+
+      | ArrayFill x, Num (I32 n) :: v :: Num (I32 i) :: Ref Aggr.(ArrayRef (Array (t, fs))) :: vs' ->
+        if array_oob fs i n then
+          vs', [Trapping "out of bounds array access" @@ e.at]
+        else if n = 0l then
+          vs', []
+        else
+          vs', List.map (Lib.Fun.flip (@@) e.at) [
+            Refer (Aggr.(ArrayRef (Array (t, fs))));
+            Plain (Const (I32 i @@ e.at));
+            admin_instr_of_value v e.at;
+            Plain (ArraySet x);
+            Refer (Aggr.(ArrayRef (Array (t, fs))));
+            Plain (Const (I32 (I32.add i 1l) @@ e.at));
+            admin_instr_of_value v e.at;
+            Plain (Const (I32 (I32.sub n 1l) @@ e.at));
+            Plain (ArrayFill x);
+          ]
+
+      | ArrayInitData (x, y),
+        Num _ :: Num _ :: Num _ :: Ref (NullRef _) :: vs' ->
+        vs', [Trapping "null array reference" @@ e.at]
+
+      | ArrayInitData (x, y),
+          Num (I32 n)
+            :: Num (I32 y_off)
+              :: Num (I32 i)
+                :: Ref Aggr.(ArrayRef (Array (t, fs)))
+                  :: vs' ->
+        if array_oob fs i n then
+          vs', [Trapping "out of bounds array access" @@ e.at]
+        else if data_oob c.frame y y_off n then
+          vs', [Trapping (memory_error e.at Memory.Bounds) @@ e.at]
+        else if n = 0l then
+          vs', []
+        else
+          let ArrayT (FieldT (_mut, st)) = array_type c.frame.inst x in
+          let seg = data c.frame.inst y in
+          let j = I32.to_int_u y_off in
+          let v = value_of_data_ind seg st j e.at in
+          vs', List.map (Lib.Fun.flip (@@) e.at) [
+            Refer (Aggr.(ArrayRef (Array (t, fs))));
+            Plain (Const (I32 i @@ e.at));
+            admin_instr_of_value v e.at;
+            Plain (ArraySet x);
+            Refer (Aggr.(ArrayRef (Array (t, fs))));
+            Plain (Const (I32 (I32.add i 1l) @@ e.at));
+            Plain (Const (I32 (I32.add y_off (I32.of_int_u (storage_size st))) @@ e.at));
+            Plain (Const (I32 (I32.sub n 1l) @@ e.at));
+            Plain (ArrayInitData (x, y));
+          ]
+
+      | ArrayInitElem (x, y),
+        Num _ :: Num _ :: Num _ :: Ref (NullRef _) :: vs' ->
+        vs', [Trapping "null array reference" @@ e.at]
+
+      | ArrayInitElem (x, y),
+        Num (I32 n) :: Num (I32 s) ::
+          Num (I32 d) :: Ref Aggr.(ArrayRef (Array (t, fs))) :: vs' ->
+        if array_oob fs d n then
+          vs', [Trapping "out of bounds array access" @@ e.at]
+        else if elem_oob c.frame y s n then
+          vs', [Trapping (table_error e.at Table.Bounds) @@ e.at]
+        else if n = 0l then
+          vs', []
+        else
+          let seg = elem c.frame.inst y in
+          let v = Ref (Elem.load seg s)
+          in
+          vs', List.map (Lib.Fun.flip (@@) e.at) [
+            Refer (Aggr.(ArrayRef (Array (t, fs))));
+            Plain (Const (I32 d @@ e.at));
+            admin_instr_of_value v e.at;
+            Plain (ArraySet x);
+            Refer (Aggr.(ArrayRef (Array (t, fs))));
+            Plain (Const (I32 (I32.add d 1l) @@ e.at));
+            Plain (Const (I32 (I32.add s 1l) @@ e.at));
+            Plain (Const (I32 (I32.sub n 1l) @@ e.at));
+            Plain (ArrayInitElem (x, y));
+          ]
+
       | ExternConvert Internalize, Ref (NullRef _) :: vs' ->
         Ref (NullRef NoneHT) :: vs', []
 

diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml
@@ -213,6 +213,10 @@ and instr' =
   | ArrayGet of idx * extension option  (* read array slot *)
   | ArraySet of idx                   (* write array slot *)
   | ArrayLen                          (* read array length *)
+  | ArrayCopy of idx * idx            (* copy between two arrays *)
+  | ArrayFill of idx                  (* fill array with value *)
+  | ArrayInitData of idx * idx        (* fill array from data segment *)
+  | ArrayInitElem of idx * idx        (* fill array from elem segment *)
   | ExternConvert of externop         (* extern conversion *)
   | VecConst of vec                   (* constant *)
   | VecTest of vec_testop             (* vector test *)

diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml
@@ -137,6 +137,10 @@ let rec instr (e : instr) =
   | StructGet (x, _, _) | StructSet (x, _) -> types (idx x)
   | ArrayGet (x, _) | ArraySet x -> types (idx x)
   | ArrayLen -> empty
+  | ArrayCopy (x, y) -> types (idx x) ++ types (idx y)
+  | ArrayFill x -> types (idx x)
+  | ArrayInitData (x, y) -> types (idx x) ++ datas (idx y)
+  | ArrayInitElem (x, y) -> types (idx x) ++ elems (idx y)
   | ExternConvert _ -> empty
   | Const _ | Test _ | Compare _ | Unary _ | Binary _ | Convert _ -> empty
   | Block (bt, es) | Loop (bt, es) -> block_type bt ++ block es

diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml
@@ -127,6 +127,10 @@ let array_get_u x = ArrayGet (x, Some ZX)
 let array_get_s x = ArrayGet (x, Some SX)
 let array_set x = ArraySet x
 let array_len = ArrayLen
+let array_copy x y = ArrayCopy (x, y)
+let array_fill x = ArrayFill x
+let array_init_data x y = ArrayInitData (x, y)
+let array_init_elem x y = ArrayInitElem (x, y)
 
 let extern_internalize = ExternConvert Internalize
 let extern_externalize = ExternConvert Externalize

diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml
@@ -558,6 +558,10 @@ let rec instr e =
     | ArrayGet (x, exto) -> "array.get" ^ opt_s extension exto ^ " " ^ var x, []
     | ArraySet x -> "array.set " ^ var x, []
     | ArrayLen -> "array.len", []
+    | ArrayCopy (x, y) -> "array.copy " ^ var x ^ " " ^ var y, []
+    | ArrayFill x -> "array.fill " ^ var x, []
+    | ArrayInitData (x, y) -> "array.init_data " ^ var x ^ " " ^ var y, []
+    | ArrayInitElem (x, y) -> "array.init_elem " ^ var x ^ " " ^ var y, []
     | ExternConvert op -> "extern." ^ externop op, []
     | Const n -> constop n.it ^ " " ^ num n, []
     | Test op -> testop op, []

diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll
@@ -341,6 +341,10 @@ rule token = parse
       | "array.get_s" -> ARRAY_GET array_get_s
       | "array.set" -> ARRAY_SET
       | "array.len" -> ARRAY_LEN
+      | "array.copy" -> ARRAY_COPY
+      | "array.fill" -> ARRAY_FILL
+      | "array.init_data" -> ARRAY_INIT_DATA
+      | "array.init_elem" -> ARRAY_INIT_ELEM
 
       | "extern.internalize" -> EXTERN_CONVERT extern_internalize
       | "extern.externalize" -> EXTERN_CONVERT extern_externalize

diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly
@@ -274,6 +274,7 @@ let inline_func_type_explicit (c : context) x ft at =
 %token<Ast.idx -> Ast.idx -> Ast.instr'> STRUCT_GET
 %token ARRAY_NEW ARRAY_NEW_FIXED ARRAY_NEW_ELEM ARRAY_NEW_DATA
 %token ARRAY_SET ARRAY_LEN
+%token ARRAY_COPY ARRAY_FILL ARRAY_INIT_DATA ARRAY_INIT_ELEM
 %token<Ast.instr'> EXTERN_CONVERT
 %token<int option -> Memory.offset -> Ast.instr'> VEC_LOAD VEC_STORE
 %token<int option -> Memory.offset -> int -> Ast.instr'> VEC_LOAD_LANE VEC_STORE_LANE
@@ -568,6 +569,10 @@ plain_instr :
   | ARRAY_GET var { fun c -> $1 ($2 c type_) }
   | ARRAY_SET var { fun c -> array_set ($2 c type_) }
   | ARRAY_LEN { fun c -> array_len }
+  | ARRAY_COPY var var { fun c -> array_copy ($2 c type_) ($3 c type_) }
+  | ARRAY_FILL var { fun c -> array_fill ($2 c type_) }
+  | ARRAY_INIT_DATA var var { fun c -> array_init_data ($2 c type_) ($3 c data) }
+  | ARRAY_INIT_ELEM var var { fun c -> array_init_elem ($2 c type_) ($3 c elem) }
   | EXTERN_CONVERT { fun c -> $1 }
   | CONST num { fun c -> fst (num $1 $2) }
   | TEST { fun c -> $1 }

diff --git a/interpreter/valid/match.mli b/interpreter/valid/match.mli
@@ -49,4 +49,6 @@ val match_table_type : table_type -> table_type -> bool
 val match_memory_type : memory_type -> memory_type -> bool
 val match_global_type : global_type -> global_type -> bool
 
+val match_storage_type : rec_context -> storage_type -> storage_type -> bool
+
 val match_extern_type : extern_type -> extern_type -> bool
diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml
@@ -768,6 +768,37 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in
   | ArrayLen ->
     [RefT (Null, ArrayHT)] --> [NumT I32T], []
 
+  | ArrayCopy (x, y) ->
+    let ArrayT (FieldT (mutd, std)) = array_type c x in
+    let ArrayT (FieldT (_muts, sts)) = array_type c y in
+    require (mutd = Var) e.at "destination array is immutable";
+    require (match_storage_type [] sts std) e.at "array types do not match";
+    [RefT (Null, DefHT (type_ c x)); NumT I32T; RefT (Null, DefHT (type_ c y)); NumT I32T; NumT I32T] --> [], []
+
+  | ArrayFill x ->
+    let ArrayT (FieldT (mut, st)) = array_type c x in
+    require (mut = Var) e.at "array is immutable";
+    let t = unpacked_storage_type st in
+    [RefT (Null, DefHT (type_ c x)); NumT I32T; t; NumT I32T] --> [], []
+
+  | ArrayInitData (x, y) ->
+    let ArrayT (FieldT (mut, st)) = array_type c x in
+    require (mut = Var) e.at "array is immutable";
+    let () = data c y in
+    let t = unpacked_storage_type st in
+    require (is_num_type t || is_vec_type t) x.at
+      "array type is not numeric or vector";
+    [RefT (Null, DefHT (type_ c x)); NumT I32T; NumT I32T; NumT I32T] --> [], []
+
+  | ArrayInitElem (x, y) ->
+    let ArrayT (FieldT (mut, st)) = array_type c x in
+    require (mut = Var) e.at "array is immutable";
+    let rt = elem c y in
+    require (match_val_type [] (RefT rt) (unpacked_storage_type st)) x.at
+      ("type mismatch: element segment's type " ^ string_of_ref_type rt ^
+       " does not match array's field type " ^ string_of_field_type (FieldT (mut, st)));
+    [RefT (Null, DefHT (type_ c x)); NumT I32T; NumT I32T; NumT I32T] --> [], []
+
   | ExternConvert op ->
     let ht1, ht2 = type_externop op in
     let (nul, _ht) = peek_ref 0 s e.at in