[Interpreter] Implement rest of the instructions (#64)

`memory.init`, `data.drop`, `table.init`, `elem.drop`, `table.copy`

Also fix writing passive segments in the text format.

Author: binji

interpreter/exec/eval.ml

@@ -17,6 +17,10 @@ exception Trap = Trap.Error
 exception Crash = Crash.Error (* failure that cannot happen in valid code *)
 exception Exhaustion = Exhaustion.Error
 
+let table_error at = function
+  | Table.Bounds -> "out of bounds table access"
+  | exn -> raise exn
+
 let memory_error at = function
   | Memory.Bounds -> "out of bounds memory access"
   | Memory.SizeOverflow -> "memory size overflow"
@@ -78,6 +82,8 @@ let func (inst : module_inst) x = lookup "function" inst.funcs x
 let table (inst : module_inst) x = lookup "table" inst.tables x
 let memory (inst : module_inst) x = lookup "memory" inst.memories x
 let global (inst : module_inst) x = lookup "global" inst.globals x
+let elems (inst : module_inst) x = lookup "elems" inst.elems x
+let data (inst : module_inst) x = lookup "data" inst.data x
 let local (frame : frame) x = lookup "local" frame.locals x
 
 let elem inst x i at =
@@ -249,6 +255,22 @@ let rec step (c : config) : config =
         (try Eval_numeric.eval_cvtop cvtop v :: vs', []
         with exn -> vs', [Trapping (numeric_error e.at exn) @@ e.at])
 
+      | MemoryInit x, I32 n :: I32 s :: I32 d :: vs' ->
+        let mem = memory frame.inst (0l @@ e.at) in
+        (match !(data frame.inst x) with
+        | Some bs ->
+          let dst = I64_convert.extend_i32_u d in
+          let src = I64_convert.extend_i32_u s in
+          (try Memory.init mem bs dst src n; vs', []
+          with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at])
+        | None -> vs', [Trapping "data segment dropped" @@ e.at])
+
+      | DataDrop x, vs ->
+        let seg = data frame.inst x in
+        (match !seg with
+        | Some _ -> seg := None; vs, []
+        | None -> vs, [Trapping "data segment dropped" @@ e.at])
+
       | MemoryCopy, I32 n :: I32 s :: I32 d :: vs' ->
         let mem = memory frame.inst (0l @@ e.at) in
         let dst = I64_convert.extend_i32_u d in
@@ -262,6 +284,25 @@ let rec step (c : config) : config =
         (try Memory.fill mem addr (Int32.to_int b) n; vs', []
         with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at])
 
+      | TableInit x, I32 n :: I32 s :: I32 d :: vs' ->
+        let tab = table frame.inst (0l @@ e.at) in
+        (match !(elems frame.inst x) with
+        | Some es ->
+          (try Table.init tab es d s n; vs', []
+          with exn -> vs', [Trapping (table_error e.at exn) @@ e.at])
+        | None -> vs', [Trapping "elements segment dropped" @@ e.at])
+
+      | ElemDrop x, vs ->
+        let seg = elems frame.inst x in
+        (match !seg with
+        | Some _ -> seg := None; vs, []
+        | None -> vs, [Trapping "elements segment dropped" @@ e.at])
+
+      | TableCopy, I32 n :: I32 s :: I32 d :: vs' ->
+        let tab = table frame.inst (0l @@ e.at) in
+        (try Table.copy tab d s n; vs', []
+        with exn -> vs', [Trapping (table_error e.at exn) @@ e.at])
+
       | _ ->
         let s1 = string_of_values (List.rev vs) in
         let s2 = string_of_value_types (List.map type_of (List.rev vs)) in
@@ -394,6 +435,19 @@ let create_export (inst : module_inst) (ex : export) : export_inst =
     | GlobalExport x -> ExternGlobal (global inst x)
   in name, ext
 
+let elems_list inst init =
+  List.map (fun x -> (FuncElem (func inst x))) 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))
+
+let create_data (inst : module_inst) (seg : memory_segment) : data_inst =
+  match seg.it with
+  | Active _ -> ref None
+  | Passive init -> ref (Some init)
+
 
 let init_func (inst : module_inst) (func : func_inst) =
   match func with
@@ -405,7 +459,9 @@ let init_table (inst : module_inst) (seg : table_segment) =
   | Active {index; offset = const; init} ->
     let tab = table inst index in
     let offset = i32 (eval_const inst const) const.at in
-    (try Table.init tab offset (List.map (fun x -> FuncElem (func inst x)) init)
+    let elems = elems_list inst init in
+    let len = Int32.of_int (List.length elems) in
+    (try Table.init tab elems offset 0l len
     with Table.Bounds -> Link.error seg.at "elements segment does not fit table")
   | Passive init -> ()
 
@@ -415,7 +471,8 @@ let init_memory (inst : module_inst) (seg : memory_segment) =
     let mem = memory inst index in
     let offset' = i32 (eval_const inst const) const.at in
     let offset = I64_convert.extend_i32_u offset' in
-    (try Memory.init mem offset init
+    let len = Int32.of_int (String.length init) in
+    (try Memory.init mem init offset 0L len
     with Memory.Bounds -> Link.error seg.at "data segment does not fit memory")
   | Passive init -> ()
 
@@ -448,10 +505,16 @@ let init (m : module_) (exts : extern list) : module_inst =
       funcs = inst0.funcs @ fs;
       tables = inst0.tables @ List.map (create_table inst0) tables;
       memories = inst0.memories @ List.map (create_memory inst0) memories;
-      globals = inst0.globals @ List.map (create_global inst0) globals;
+      globals = inst0.globals @ List.map (create_global inst0) globals
+    }
+  in
+  let inst =
+    { inst1 with
+      exports = List.map (create_export inst1) exports;
+      elems = List.map (create_elems inst1) elems;
+      data = List.map (create_data inst1) data
     }
   in
-  let inst = {inst1 with exports = List.map (create_export inst1) exports} in
   List.iter (init_func inst) fs;
   List.iter (init_table inst) elems;
   List.iter (init_memory inst) data;

interpreter/runtime/instance.ml

@@ -8,13 +8,17 @@ type module_inst =
   memories : memory_inst list;
   globals : global_inst list;
   exports : export_inst list;
+  elems : elems_inst list;
+  data : data_inst list;
 }
 
 and func_inst = module_inst ref Func.t
 and table_inst = Table.t
 and memory_inst = Memory.t
 and global_inst = Global.t
 and export_inst = Ast.name * extern
+and elems_inst = Table.elem list option ref
+and data_inst = string option ref
 
 and extern =
   | ExternFunc of func_inst
@@ -29,7 +33,7 @@ type Table.elem += FuncElem of func_inst
 
 let empty_module_inst =
   { types = []; funcs = []; tables = []; memories = []; globals = [];
-    exports = [] }
+    exports = []; elems = []; data = [] }
 
 let extern_type_of = function
   | ExternFunc func -> ExternFuncType (Func.type_of func)

interpreter/runtime/memory.ml

@@ -145,13 +145,23 @@ let store_packed sz mem a o v =
     | _ -> raise Type
   in storen mem a o n x
 
+let check_str_bounds bs a =
+  if I64.gt_u a (Int64.of_int (String.length bs)) then raise Bounds
+
 let check_bounds mem a = if I64.gt_u a (bound mem) then raise Bounds
 
-let init mem a bs =
-  for i = 0 to String.length bs - 1 do
-    store_byte mem Int64.(add a (of_int i)) (Char.code bs.[i])
-  done;
-  check_bounds mem Int64.(add a (of_int (String.length bs)))
+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;
+      loop (Int64.add d 1L) (Int64.add s 1L) (Int32.sub n 1l)
+    end
+  in loop d s n;
+  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

interpreter/runtime/memory.mli

@@ -44,6 +44,7 @@ val store_packed :
   pack_size -> memory -> address -> offset -> value -> unit
     (* raises Type, Bounds *)
 
-val init : memory -> address -> string -> unit (* raises Bounds *)
+val init :
+  memory -> string -> address -> address -> count -> unit (* raises Bounds *)
 val copy : memory -> address -> address -> count -> unit (* raises Bounds *)
 val fill : memory -> address -> int -> count -> unit (* raises Bounds *)

interpreter/runtime/table.ml

@@ -2,6 +2,7 @@ open Types
 
 type size = int32
 type index = int32
+type count = int32
 
 type elem = ..
 type elem += Uninitialized
@@ -50,6 +51,28 @@ let store tab i v =
 
 let check_bounds tab i = if I32.gt_u i (size tab) then raise Bounds
 
-let init tab offset elems =
-  List.iteri (fun i -> store tab (Int32.(add offset (of_int i)))) elems;
-  check_bounds tab Int32.(add offset (of_int (List.length elems)))
+let init tab es d s n =
+  let rec loop es d s n =
+    match s, n, es with
+    | 0l, 0l, _ -> ()
+    | 0l, n, e::es' ->
+      store tab d e;
+      loop es' (Int32.add d 1l) 0l (Int32.sub n 1l)
+    | s, n, _::es' -> loop es' d (Int32.sub s 1l) n
+    | _ -> raise Bounds
+  in loop 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 rec loop d s n dx =
+    if 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
+  in (if overlap && s < d then
+    loop Int32.(add d (sub n 1l)) Int32.(add s (sub n 1l)) n (-1l)
+  else
+    loop d s n 1l);
+  check_bounds tab (Int32.add d n);
+  check_bounds tab (Int32.add s n)

interpreter/runtime/table.mli

@@ -5,6 +5,7 @@ type t = table
 
 type size = int32
 type index = int32
+type count = int32
 
 type elem = ..
 type elem += Uninitialized
@@ -21,4 +22,6 @@ val grow : table -> size -> unit (* raises SizeOverflow, SizeLimit *)
 val load : table -> index -> elem (* raises Bounds *)
 val store : table -> index -> elem -> unit (* raises Bounds *)
 
-val init : table -> index -> elem list -> unit (* raises Bounds *)
+val init :
+  table -> elem list -> index -> index -> count -> unit (* raises Bounds *)
+val copy : table -> index -> index -> count -> unit (* raises Bounds *)

interpreter/text/arrange.ml

@@ -300,7 +300,7 @@ let segment head dat seg =
   match seg.it with
   | Active {index; offset; init} ->
     Node (head, atom var index :: Node ("offset", const offset) :: dat init)
-  | Passive init -> Node (head, dat init)
+  | Passive init -> Node (head ^ " passive", dat init)
 
 let elems seg =
   segment "elem" (list (atom var)) seg