[Interpreter] Fix bugs found by Lars' tests (#66)

* The data count section is required if the `memory.init` or `data.drop`
  instructions are used.

* `memory.init` had an off-by-one bug when reading at the end of a segment.

* All instructions that operate on regions need to compare length to 0
  using unsigned comparison (e.g. `I32.gt_u n 0l`).

* Converting length from 32- to 64-bit now uses
  `I64_convert.extend_i32_u`, instead of `Int64.of_int32`, since the
  latter will sign-extend.

* The `table.copy` overlap test now uses an unsigned comparison.

* The passive element text syntax still allows function indexes, e.g.
  `(elem passive $f1 $f2)`.

* Add element type to passive element segments

Author: binji

interpreter/binary/decode.ml

@@ -5,11 +5,12 @@ type stream =
   name : string;
   bytes : string;
   pos : int ref;
+  has_data_count : bool ref;
 }
 
 exception EOS
 
-let stream name bs = {name; bytes = bs; pos = ref 0}
+let stream name bs = {name; bytes = bs; pos = ref 0; has_data_count = ref false}
 
 let len s = String.length s.bytes
 let pos s = !(s.pos)
@@ -201,14 +202,18 @@ let memop s =
   let offset = vu32 s in
   Int32.to_int align, offset
 
+let check_data_count s =
+  require !(s.has_data_count) s (pos s - 1) "data count section required"
+
 let misc_instr s =
   let pos = pos s in
   match op s with
   | 0x08 ->
+    check_data_count s;
     let x = at var s in
     zero_flag s;
     memory_init x
-  | 0x09 -> data_drop (at var s)
+  | 0x09 -> check_data_count s; data_drop (at var s)
   | 0x0a -> zero_flag s; zero_flag s; memory_copy
   | 0x0b -> zero_flag s; memory_fill
   | 0x0c ->
@@ -640,8 +645,16 @@ let passive_elem s =
     Func x
   | _ -> error s (pos s - 1) "invalid elem"
 
+let active_elem_segment s =
+  FuncRefType, vec (at active_elem) s
+
+let passive_elem_segment s =
+  let etype = elem_type s in
+  let init = vec (at passive_elem) s in
+  etype, init
+
 let table_segment s =
-  segment (vec (at active_elem)) (vec (at passive_elem)) s
+  segment active_elem_segment passive_elem_segment s
 
 let elem_section s =
   section `ElemSection (vec (at table_segment)) [] s
@@ -659,7 +672,10 @@ let data_section s =
 (* DataCount section *)
 
 let data_count_section s =
-  section `DataCountSection (opt vu32 true) None s
+  let contents s =
+    s.has_data_count := true;
+    opt vu32 true s
+  in section `DataCountSection contents None s
 
 
 (* Custom section *)

interpreter/binary/encode.ml

@@ -501,7 +501,9 @@ let encode m =
       | Func x -> u8 0xd2; var x; end_ ()
 
     let table_segment seg =
-      segment (vec active_elem) (vec passive_elem) seg
+      let active (_,init) = vec active_elem init in
+      let passive (etype,init) = elem_type etype; vec passive_elem init in
+      segment active passive seg
 
     let elem_section elems =
       section 9 (vec table_segment) elems (elems <> [])

interpreter/exec/eval.ml

@@ -445,7 +445,7 @@ let elems_list inst init =
 let create_elems (inst : module_inst) (seg : table_segment) : elems_inst =
   match seg.it with
   | Active _ -> ref None
-  | Passive init -> ref (Some (elems_list inst init))
+  | Passive (_,init) -> ref (Some (elems_list inst init))
 
 let create_data (inst : module_inst) (seg : memory_segment) : data_inst =
   match seg.it with
@@ -460,7 +460,7 @@ let init_func (inst : module_inst) (func : func_inst) =
 
 let init_table (inst : module_inst) (seg : table_segment) =
   match seg.it with
-  | Active {index; offset = const; init} ->
+  | Active {index; offset = const; init = (_,init)} ->
     let tab = table inst index in
     let offset = i32 (eval_const inst const) const.at in
     let elems = elems_list inst init in

interpreter/runtime/memory.ml

@@ -151,23 +151,24 @@ let check_str_bounds bs a =
 let check_bounds mem a = if I64.gt_u a (bound mem) then raise Bounds
 
 let init mem bs d s n =
-  let n' = Int64.of_int32 n in
-  let rec loop d s n =
-    if n > 0l then begin
-      check_str_bounds bs s;
-      let b = (Char.code bs.[Int64.to_int s]) in
-      store_byte mem d b;
+  let load_str_byte a =
+    try Char.code bs.[Int64.to_int a]
+    with _ -> raise Bounds
+  in let rec loop d s n =
+    if I32.gt_u n 0l then begin
+      store_byte mem d (load_str_byte s);
       loop (Int64.add d 1L) (Int64.add s 1L) (Int32.sub n 1l)
     end
   in loop d s n;
+  let n' = I64_convert.extend_i32_u n in
   check_bounds mem (Int64.add d n');
   check_str_bounds bs (Int64.add s n')
 
 let copy mem d s n =
-  let n' = Int64.of_int32 n in
-  let overlap = I64.lt_s Int64.(abs (sub d s)) n' in
+  let n' = I64_convert.extend_i32_u n in
+  let overlap = I64.lt_u Int64.(abs (sub d s)) n' in
   let rec loop d s n dx =
-    if n > 0l then begin
+    if I32.gt_u n 0l then begin
       store_byte mem d (load_byte mem s);
       loop (Int64.add d dx) (Int64.add s dx) (Int32.sub n 1l) dx
     end
@@ -180,9 +181,9 @@ let copy mem d s n =
 
 let fill mem a v n =
   let rec loop a n =
-    if n > 0l then begin
+    if I32.gt_u n 0l then begin
       store_byte mem a v;
       loop (Int64.add a 1L) (Int32.sub n 1l)
     end
   in loop a n;
-  check_bounds mem Int64.(add a (of_int32 n))
+  check_bounds mem (Int64.add a (I64_convert.extend_i32_u n))

interpreter/runtime/table.ml

@@ -64,9 +64,9 @@ let init tab es d s n =
   check_bounds tab (Int32.add d n)
 
 let copy tab d s n =
-  let overlap = I32.lt_s Int32.(abs (sub d s)) n in
+  let overlap = I32.lt_u Int32.(abs (sub d s)) n in
   let rec loop d s n dx =
-    if n > 0l then begin
+    if I32.gt_u n 0l then begin
       store tab d (load tab s);
       loop (Int32.add d dx) (Int32.add s dx) (Int32.sub n 1l) dx
     end

interpreter/syntax/ast.ml

@@ -150,7 +150,7 @@ and elem' =
   | Null
   | Func of var
 
-type table_segment = elem list segment
+type table_segment = (elem_type * (elem list)) segment
 type memory_segment = string segment
 
 
@@ -196,8 +196,8 @@ and module_' =
   memories : memory list;
   funcs : func list;
   start : var option;
-  elems : elem list segment list;
-  data : string segment list;
+  elems : table_segment list;
+  data : memory_segment list;
   imports : import list;
   exports : export list;
 }

interpreter/text/arrange.ml

@@ -313,7 +313,9 @@ let passive_elem el =
   | Func x -> Node ("ref.func", [atom var x])
 
 let elems seg =
-  segment "elem" (list active_elem) (list passive_elem) seg
+  let active (_,init) = list active_elem init in
+  let passive (etype,init) = atom elem_type etype :: list passive_elem init in
+  segment "elem" active passive seg
 
 let data seg =
   segment "data" break_bytes break_bytes seg

interpreter/text/parser.mly

@@ -572,6 +572,7 @@ offset :
 elemref :
   | LPAR REF_NULL RPAR { let at = at () in fun c -> Null @@ at }
   | LPAR REF_FUNC var RPAR { let at = at () in fun c -> Func ($3 c func) @@ at }
+  | var { let at = at () in fun c -> Func ($1 c func) @@ at }
 
 passive_elemref_list :
   | /* empty */ { fun c -> [] }
@@ -583,25 +584,28 @@ active_elemref_list :
       fun c lookup -> List.map f ($1 c lookup) }
 
 elem :
-  | LPAR ELEM bind_var_opt PASSIVE passive_elemref_list RPAR
+  | LPAR ELEM bind_var_opt PASSIVE elem_type passive_elemref_list RPAR
     { let at = at () in
       fun c -> ignore ($3 c anon_elem bind_elem);
-      fun () -> Passive ($5 c) @@ at }
+      fun () -> Passive ($5, ($6 c)) @@ at }
   | LPAR ELEM bind_var var offset active_elemref_list RPAR
     { let at = at () in
       fun c -> ignore (bind_elem c $3);
       fun () ->
-      Active {index = $4 c table; offset = $5 c; init = $6 c func} @@ at }
+      let init = FuncRefType, ($6 c func) in
+      Active {index = $4 c table; offset = $5 c; init} @@ at }
   | LPAR ELEM var offset active_elemref_list RPAR
     { let at = at () in
       fun c -> ignore (anon_elem c);
       fun () ->
-      Active {index = $3 c table; offset = $4 c; init = $5 c func} @@ at }
+      let init = FuncRefType, $5 c func in
+      Active {index = $3 c table; offset = $4 c; init} @@ at }
   | LPAR ELEM offset active_elemref_list RPAR  /* Sugar */
     { let at = at () in
       fun c -> ignore (anon_elem c);
       fun () ->
-      Active {index = 0l @@ at; offset = $3 c; init = $4 c func} @@ at }
+      let init = FuncRefType, $4 c func in
+      Active {index = 0l @@ at; offset = $3 c; init} @@ at }
 
 table :
   | LPAR TABLE bind_var_opt table_fields RPAR
@@ -623,7 +627,8 @@ table_fields :
   | elem_type LPAR ELEM active_elemref_list RPAR  /* Sugar */
     { fun c x at ->
       let offset = [i32_const (0l @@ at) @@ at] @@ at in
-      let init = $4 c func in let size = Int32.of_int (List.length init) in
+      let init' = $4 c func in let size = Int32.of_int (List.length init') in
+      let init = FuncRefType, init' in
       [{ttype = TableType ({min = size; max = Some size}, $1)} @@ at],
       [Active {index = x; offset; init} @@ at],
       [], [] }

interpreter/valid/valid.ml

@@ -431,11 +431,11 @@ let check_elemref (c : context) (el : elem) =
 
 let check_elem (c : context) (seg : table_segment) =
   match seg.it with
-  | Active {index; offset; init} ->
+  | Active {index; offset; init = (_,init)} ->
     ignore (table c index);
     check_const c offset I32Type;
     List.iter (check_elemref c) init
-  | Passive init ->
+  | Passive (etype,init) ->
     List.iter (check_elemref c) init
 
 let check_data (c : context) (seg : memory_segment) =

test/core/bulk.wast

@@ -5,7 +5,7 @@
 
 (module
   (table 3 funcref)
-  (elem passive (ref.func 0) (ref.null) (ref.func 1))
+  (elem passive funcref (ref.func 0) (ref.null) (ref.func 1))
   (func)
   (func))
 
@@ -182,7 +182,7 @@
 ;; table.init
 (module
   (table 3 funcref)
-  (elem passive
+  (elem passive funcref
     (ref.func $zero) (ref.func $one) (ref.func $zero) (ref.func $one))
 
   (func $zero (result i32) (i32.const 0))
@@ -227,7 +227,7 @@
 (module
   (table 1 funcref)
   (func $f)
-  (elem $p passive (ref.func $f))
+  (elem $p passive funcref (ref.func $f))
   (elem $a 0 (i32.const 0) $f)
 
   (func (export "drop_passive") (elem.drop $p))