Update interpreter and test suite for table64 (WebAssembly#53)

Author: sbc100

.github/workflows/ci-interpreter.yml

@@ -31,4 +31,6 @@ jobs:
       - name: Build interpreter
         run: cd interpreter && opam exec make
       - name: Run tests
-        run: cd interpreter && opam exec make JS="node --experimental-wasm-memory64"  ci
+        # Re-enable the JS tests once table64 is available under node
+        #run: cd interpreter && opam exec make JS="node --experimental-wasm-memory64"  ci
+        run: cd interpreter && opam exec make ci

interpreter/binary/decode.ml

@@ -190,9 +190,8 @@ let limits uN s =
 
 let table_type s =
   let t = ref_type s in
-  let lim, is64 = limits u32 s in
-  require (not is64) s (pos s - 1) "tables cannot have 64-bit indices";
-  TableType (lim, t)
+  let lim, is64 = limits u64 s in
+  TableType (lim, (if is64 then I64IndexType else I32IndexType), t)
 
 let memory_type s =
   let lim, is64 = limits u64 s in

interpreter/binary/encode.ml

@@ -123,7 +123,7 @@ struct
     byte flags; vu min; opt vu max
 
   let table_type = function
-    | TableType (lim, t) -> ref_type t; limits u32 lim I32IndexType
+    | TableType (lim, it, t) -> ref_type t; limits u64 lim it
 
   let memory_type = function
     | MemoryType (lim, it) -> limits u64 lim it

interpreter/exec/eval.ml

@@ -93,13 +93,13 @@ let local (frame : frame) x = lookup "local" frame.locals x
 
 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)
+    Trap.error at ("undefined element " ^ Int64.to_string i)
 
 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)
+  | NullRef _ -> Trap.error at ("uninitialized element " ^ Int64.to_string i)
+  | _ -> Crash.error at ("type mismatch for element " ^ Int64.to_string i)
 
 let func_type_of = function
   | Func.AstFunc (t, inst, f) -> t
@@ -140,12 +140,12 @@ let data_oob frame x i n =
     (Data.size (data frame.inst x))
 
 let table_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 (Table.size (table frame.inst x)))
+  I64.gt_u (I64.add (Table.index_of_num i) (Table.index_of_num n))
+    (Table.size (table frame.inst x))
 
 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)))
+  I64.gt_u (I64.add (Table.index_of_num i) (Table.index_of_num n))
+    (Elem.size (elem frame.inst x))
 
 let inc_address i at =
   match i with
@@ -206,7 +206,8 @@ let rec step (c : config) : config =
       | Call x, vs ->
         vs, [Invoke (func frame.inst x) @@ e.at]
 
-      | CallIndirect (x, y), Num (I32 i) :: vs ->
+      | CallIndirect (x, y), Num n :: vs ->
+        let i = Table.index_of_num n in
         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]
@@ -241,85 +242,96 @@ 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")
 
-      | TableGet x, Num (I32 i) :: vs' ->
+      | TableGet x, Num n :: vs' ->
+        let i = Table.index_of_num n in
         (try Ref (Table.load (table frame.inst x) i) :: vs', []
         with exn -> vs', [Trapping (table_error e.at exn) @@ e.at])
 
-      | TableSet x, Ref r :: Num (I32 i) :: vs' ->
+      | TableSet x, Ref r :: Num n :: vs' ->
+        let i = Table.index_of_num n in
         (try Table.store (table frame.inst x) i r; vs', []
         with exn -> vs', [Trapping (table_error e.at exn) @@ e.at])
 
       | TableSize x, vs ->
-        Num (I32 (Table.size (table frame.inst x))) :: vs, []
+        let tab = table frame.inst x in
+        value_of_index (Table.index_type_of tab) (Table.size (table frame.inst x)) :: vs, []
 
-      | TableGrow x, Num (I32 delta) :: Ref r :: vs' ->
+      | TableGrow x, Num delta :: Ref r :: vs' ->
         let tab = table frame.inst x in
         let old_size = Table.size tab in
         let result =
-          try Table.grow tab delta r; old_size
-          with Table.SizeOverflow | Table.SizeLimit | Table.OutOfMemory -> -1l
-        in Num (I32 result) :: vs', []
+          try Table.grow tab (Table.index_of_num delta) r; old_size
+          with Table.SizeOverflow | Table.SizeLimit | Table.OutOfMemory -> -1L
+        in (value_of_index (Table.index_type_of tab) result) :: vs', []
 
-      | TableFill x, Num (I32 n) :: Ref r :: Num (I32 i) :: vs' ->
+      | TableFill x, Num n :: Ref r :: Num i :: vs' ->
+        let n_64 = Table.index_of_num n in
         if table_oob frame x i n then
           vs', [Trapping (table_error e.at Table.Bounds) @@ e.at]
-        else if n = 0l then
+        else if n_64 = 0L then
           vs', []
         else
-          let _ = assert (I32.lt_u i 0xffff_ffffl) in
+          let i_64 = Table.index_of_num i in
+          let _ = assert (I64.lt_u i_64 0xffff_ffff_ffff_ffffL) in
           vs', List.map (at e.at) [
-            Plain (Const (I32 i @@ e.at));
+            Plain (Const (I64 i_64 @@ e.at));
             Refer r;
             Plain (TableSet x);
-            Plain (Const (I32 (I32.add i 1l) @@ e.at));
+            Plain (Const (I64 (I64.add i_64 1L) @@ e.at));
             Refer r;
-            Plain (Const (I32 (I32.sub n 1l) @@ e.at));
+            Plain (Const (I64 (I64.sub n_64 1L) @@ e.at));
             Plain (TableFill x);
           ]
 
-      | TableCopy (x, y), Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' ->
+      | TableCopy (x, y), Num n :: Num s :: Num d :: vs' ->
+        let n_64 = Table.index_of_num n in
+        let s_64 = Table.index_of_num s in
+        let d_64 = Table.index_of_num d in
         if table_oob frame x d n || table_oob frame y s n then
           vs', [Trapping (table_error e.at Table.Bounds) @@ e.at]
-        else if n = 0l then
+        else if n_64 = 0L then
           vs', []
-        else if I32.le_u d s then
+        else if I64.le_u d_64 s_64 then
           vs', List.map (at e.at) [
-            Plain (Const (I32 d @@ e.at));
-            Plain (Const (I32 s @@ e.at));
+            Plain (Const (I64 d_64 @@ e.at));
+            Plain (Const (I64 s_64 @@ e.at));
             Plain (TableGet y);
             Plain (TableSet x);
-            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 (Const (I64 (I64.add d_64 1L) @@ e.at));
+            Plain (Const (I64 (I64.add s_64 1L) @@ e.at));
+            Plain (Const (I64 (I64.sub n_64 1L) @@ e.at));
             Plain (TableCopy (x, y));
           ]
         else (* d > s *)
-          let n' = I32.sub n 1l in
+          let n' = I64.sub n_64 1L in
           vs', List.map (at e.at) [
-            Plain (Const (I32 (I32.add d n') @@ e.at));
-            Plain (Const (I32 (I32.add s n') @@ e.at));
+            Plain (Const (I64 (I64.add d_64 n') @@ e.at));
+            Plain (Const (I64 (I64.add s_64 n') @@ e.at));
             Plain (TableGet y);
             Plain (TableSet x);
-            Plain (Const (I32 d @@ e.at));
-            Plain (Const (I32 s @@ e.at));
-            Plain (Const (I32 n' @@ e.at));
+            Plain (Const (I64 d_64 @@ e.at));
+            Plain (Const (I64 s_64 @@ e.at));
+            Plain (Const (I64 n' @@ e.at));
             Plain (TableCopy (x, y));
           ]
 
-      | TableInit (x, y), Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' ->
+      | TableInit (x, y), Num n :: Num s :: Num d :: vs' ->
+        let n_64 = Table.index_of_num n in
         if table_oob frame x d n || elem_oob frame y s n then
           vs', [Trapping (table_error e.at Table.Bounds) @@ e.at]
-        else if n = 0l then
+        else if n_64 = 0L then
           vs', []
         else
+          let d_64 = Table.index_of_num d in
+          let s_64 = Table.index_of_num s in
           let seg = elem frame.inst y in
           vs', List.map (at e.at) [
-            Plain (Const (I32 d @@ e.at));
-            Refer (Elem.load seg s);
+            Plain (Const (I64 d_64 @@ e.at));
+            Refer (Elem.load seg s_64);
             Plain (TableSet x);
-            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 (Const (I64 (I64.add d_64 1L) @@ e.at));
+            Plain (Const (I64 (I64.add s_64 1L) @@ e.at));
+            Plain (Const (I64 (I64.sub n_64 1L) @@ e.at));
             Plain (TableInit (x, y));
           ]
 
@@ -411,15 +423,15 @@ let rec step (c : config) : config =
       | MemorySize, vs ->
         let mem = memory frame.inst (0l @@ e.at) in
 
-        Memory.value_of_address (Memory.index_of mem) (Memory.size mem) :: vs, []
+        value_of_index (Memory.index_type_of mem) (Memory.size mem) :: vs, []
 
       | MemoryGrow, Num delta :: vs' ->
         let mem = memory frame.inst (0l @@ e.at) in
         let old_size = Memory.size mem in
         let result =
           try Memory.grow mem (Memory.address_of_num delta); old_size
           with Memory.SizeOverflow | Memory.SizeLimit | Memory.OutOfMemory -> -1L
-        in (Memory.value_of_address (Memory.index_of mem) result) :: vs', []
+        in (value_of_index (Memory.index_type_of mem) result) :: vs', []
 
       | MemoryFill, Num n :: Num k :: Num i :: vs' ->
         let n_64 = Memory.address_of_num n in
@@ -709,7 +721,7 @@ let create_func (inst : module_inst) (f : func) : func_inst =
 
 let create_table (inst : module_inst) (tab : table) : table_inst =
   let {ttype} = tab.it in
-  let TableType (_lim, t) = ttype in
+  let TableType (_lim, _it, t) = ttype in
   Table.alloc ttype (NullRef t)
 
 let create_memory (inst : module_inst) (mem : memory) : memory_inst =

interpreter/host/spectest.ml

@@ -19,7 +19,10 @@ let global (GlobalType (t, _) as gt) =
   in Global.alloc gt v
 
 let table =
-  Table.alloc (TableType ({min = 10l; max = Some 20l}, FuncRefType))
+  Table.alloc (TableType ({min = 10L; max = Some 20L}, I32IndexType, FuncRefType))
+    (NullRef FuncRefType)
+let table64 =
+  Table.alloc (TableType ({min = 10L; max = Some 20L}, I64IndexType, FuncRefType))
     (NullRef FuncRefType)
 let memory = Memory.alloc (MemoryType ({min = 1L; max = Some 2L}, I32IndexType))
 let func f t = Func.alloc_host t (f t)
@@ -51,5 +54,6 @@ let lookup name t =
   | "global_f32", _ -> ExternGlobal (global (GlobalType (NumType F32Type, Immutable)))
   | "global_f64", _ -> ExternGlobal (global (GlobalType (NumType F64Type, Immutable)))
   | "table", _ -> ExternTable table
+  | "table64", _ -> ExternTable table64
   | "memory", _ -> ExternMemory memory
   | _ -> raise Not_found

interpreter/runtime/elem.ml

@@ -4,10 +4,10 @@ type t = elem
 exception Bounds
 
 let alloc rs = ref rs
-let size seg = Lib.List32.length !seg
+let size seg = Lib.List64.length !seg
 
 let load seg i =
-  if i < 0l || i >= Lib.List32.length !seg then raise Bounds;
-  Lib.List32.nth !seg i
+  if i < 0L || i >= Lib.List64.length !seg then raise Bounds;
+  Lib.List64.nth !seg i
 
 let drop seg = seg := []

interpreter/runtime/memory.ml

@@ -47,14 +47,9 @@ let size mem =
 let type_of mem =
   mem.ty
 
-let index_of mem =
+let index_type_of mem =
   let (MemoryType (_, it)) = type_of mem in it
 
-let value_of_address it x =
-  match it with
-  | I64IndexType -> Num (I64 x)
-  | I32IndexType -> Num (I32 (Int64.to_int32 x))
-
 let address_of_num x =
   match x with
   | I64 i -> i
@@ -74,7 +69,7 @@ let grow mem delta =
   if I64.gt_u old_size new_size then raise SizeOverflow else
   let lim' = {lim with min = new_size} in
   if not (valid_limits lim') then raise SizeLimit else
-  let after = create new_size (index_of mem) in
+  let after = create new_size (index_type_of mem) in
   let dim = Array1_64.dim mem.content in
   Array1.blit (Array1_64.sub mem.content 0L dim) (Array1_64.sub after 0L dim);
   mem.ty <- MemoryType (lim', it);

interpreter/runtime/memory.mli

@@ -19,10 +19,9 @@ val page_size : int64
 
 val alloc : memory_type -> memory (* raises Type, SizeOverflow, OutOfMemory *)
 val type_of : memory -> memory_type
-val index_of : memory -> index_type
+val index_type_of : memory -> index_type
 val size : memory -> size
 val bound : memory -> address
-val value_of_address : index_type -> address -> value
 val address_of_value : value -> address
 val address_of_num : num -> address
 val grow : memory -> size -> unit

interpreter/runtime/table.ml

@@ -1,8 +1,8 @@
 open Types
 open Values
 
-type size = int32
-type index = int32
+type size = int64
+type index = int64
 type count = int32
 
 type table = {mutable ty : table_type; mutable content : ref_ array}
@@ -17,47 +17,62 @@ exception OutOfMemory
 let valid_limits {min; max} =
   match max with
   | None -> true
-  | Some m -> I32.le_u min m
+  | Some m -> I64.le_u min m
+
+let valid_index it i =
+  match it with
+  | I32IndexType -> I64.le_u i 0xffff_ffffL
+  | I64IndexType -> true
 
 let create size r =
-  try Lib.Array32.make size r
+  try Lib.Array64.make size r
   with Out_of_memory | Invalid_argument _ -> raise OutOfMemory
 
-let alloc (TableType (lim, _) as ty) r =
+let alloc (TableType (lim, it, _) as ty) r =
   if not (valid_limits lim) then raise Type;
   {ty; content = create lim.min r}
 
 let size tab =
-  Lib.Array32.length tab.content
+  Lib.Array64.length tab.content
 
 let type_of tab =
   tab.ty
 
+let index_type_of tab =
+  let (TableType (_, it, _)) = type_of tab in it
+
+let index_of_num x =
+  match x with
+  | I64 i -> i
+  | I32 i -> I64_convert.extend_i32_u i
+  | _ -> raise Type
+
 let grow tab delta r =
-  let TableType (lim, t) = tab.ty in
+  let TableType (lim, it, t) = tab.ty in
   assert (lim.min = size tab);
   let old_size = lim.min in
-  let new_size = Int32.add old_size delta in
-  if I32.gt_u old_size new_size then raise SizeOverflow else
+  let new_size = Int64.add old_size delta in
+  if I64.gt_u old_size new_size then raise SizeOverflow else
   let lim' = {lim with min = new_size} in
+  if not (valid_index it new_size) then raise SizeOverflow else
   if not (valid_limits lim') then raise SizeLimit else
   let after = create new_size r in
   Array.blit tab.content 0 after 0 (Array.length tab.content);
-  tab.ty <- TableType (lim', t);
+  tab.ty <- TableType (lim', it, t);
   tab.content <- after
 
 let load tab i =
-  if i < 0l || i >= Lib.Array32.length tab.content then raise Bounds;
-  Lib.Array32.get tab.content i
+  if i < 0L || i >= Lib.Array64.length tab.content then raise Bounds;
+  Lib.Array64.get tab.content i
 
 let store tab i r =
-  let TableType (lim, t) = tab.ty in
+  let TableType (_lim, _it, t) = tab.ty in
   if type_of_ref r <> t then raise Type;
-  if i < 0l || i >= Lib.Array32.length tab.content then raise Bounds;
-  Lib.Array32.set tab.content i r
+  if i < 0L || i >= Lib.Array64.length tab.content then raise Bounds;
+  Lib.Array64.set tab.content i r
 
 let blit tab offset rs =
   let data = Array.of_list rs in
-  let len = Lib.Array32.length data in
-  if offset < 0l || offset > Int32.sub (Lib.Array32.length tab.content) len then raise Bounds;
-  Lib.Array32.blit data 0l tab.content offset len
+  let len = Lib.Array64.length data in
+  if offset < 0L || offset > Int64.sub (Lib.Array64.length tab.content) len then raise Bounds;
+  Lib.Array64.blit data 0L tab.content offset len