Check all segment bounds beforehand

interpreter/spec/eval.ml

@@ -359,19 +359,23 @@ let init_closure (inst : instance) (clos : closure) =
   | _ -> assert false
 
 let init_table (inst : instance) (seg : table_segment) =
-  let {index; offset; init} = seg.it in
+  let {index; offset = const; init} = seg.it in
   let tab = table inst index in
-  let offset = i32 (eval_const inst offset) offset.at in
-  try Table.blit tab offset (List.map (fun x -> Func (func inst x)) init)
-  with Table.Bounds -> Link.error seg.at "elements segment does not fit table"
+  let offset = i32 (eval_const inst const) const.at in
+  let bound = Table.size tab in
+  if I32.lt_u bound Int32.(add offset (of_int (List.length init))) then
+    Link.error seg.at "elements segment does not fit table";
+  fun () -> Table.blit tab offset (List.map (fun x -> Func (func inst x)) init)
 
 let init_memory (inst : instance) (seg : memory_segment) =
-  let {index; offset; init} = seg.it in
+  let {index; offset = const; init} = seg.it in
   let mem = memory inst index in
-  let offset = i32 (eval_const inst offset) offset.at in
-  let offset64 = Int64.(logand (of_int32 offset) 0xffffffffL) in
-  try Memory.blit mem offset64 init
-  with Memory.Bounds -> Link.error seg.at "data segment does not fit memory"
+  let offset' = i32 (eval_const inst const) const.at in
+  let offset = I64_convert.extend_u_i32 offset' in
+  let bound = Memory.bound mem in
+  if I64.lt_u bound Int64.(add offset (of_int (String.length init))) then
+    Link.error seg.at "data segment does not fit memory";
+  fun () -> Memory.blit mem offset init
 
 let init_global (inst : instance) (ref : value ref) (glob : global) =
   let {value; _} = glob.it in
@@ -436,7 +440,9 @@ let init (m : module_) (exts : extern list) : instance =
   in
   List.iter2 (init_global inst) gs globals;
   List.iter (init_closure inst) fs;
-  List.iter (init_table inst) elems;
-  List.iter (init_memory inst) data;
+  let init_elems = List.map (init_table inst) elems in
+  let init_datas = List.map (init_memory inst) data in
+  List.iter (fun f -> f ()) init_elems;
+  List.iter (fun f -> f ()) init_datas;
   Lib.Option.app (fun x -> ignore (invoke (func inst x) [])) start;
   {inst with exports = List.fold_right (add_export inst) exports inst.exports}

interpreter/spec/eval.mli

@@ -5,5 +5,5 @@ exception Link of Source.region * string
 exception Trap of Source.region * string
 exception Crash of Source.region * string
 
-val init : Ast.module_ -> extern list -> instance
+val init : Ast.module_ -> extern list -> instance (* raises Link, Trap *)
 val invoke : closure -> value list -> value list (* raises Trap *)

interpreter/spec/memory.ml

@@ -48,8 +48,11 @@ let create {min; max} =
   assert (within_limits min max);
   {content = create' min; max}
 
+let bound mem =
+  Array1_64.dim mem.content
+
 let size mem =
-  Int64.(to_int32 (div (Array1_64.dim mem.content) page_size))
+  Int64.(to_int32 (div (bound mem) page_size))
 
 let limits mem =
   {min = size mem; max = mem.max}

interpreter/spec/memory.mli

@@ -23,6 +23,7 @@ val mem_size : mem_size -> int
 
 val create : size limits -> memory (* raise SizeOverflow, OutOfMemory *)
 val size : memory -> size
+val bound : memory -> address
 val limits : memory -> size limits
 val grow : memory -> size -> unit
   (* raise SizeLimit, SizeOverflow, OutOfMemory *)

interpreter/test/linking.wast

@@ -158,17 +158,39 @@
 
 (assert_unlinkable
   (module
-    (func $host (import "spectest" "print"))
     (table (import "Mt" "tab") 10 anyfunc)
     (memory (import "Mt" "mem") 1)  ;; does not exist
-    (elem (i32.const 7) $own)
-    (elem (i32.const 9) $host)
-    (func $own (result i32) (i32.const 666))
+    (func $f (result i32) (i32.const 0))
+    (elem (i32.const 7) $f)
+    (elem (i32.const 9) $f)
   )
   "unknown import"
 )
 (assert_trap (invoke $Mt "call" (i32.const 7)) "uninitialized")
 
+(assert_unlinkable
+  (module
+    (table (import "Mt" "tab") 10 anyfunc)
+    (func $f (result i32) (i32.const 0))
+    (elem (i32.const 7) $f)
+    (elem (i32.const 12) $f)  ;; out of bounds
+  )
+  "elements segment does not fit"
+)
+(assert_trap (invoke $Mt "call" (i32.const 7)) "uninitialized")
+
+(assert_unlinkable
+  (module
+    (table (import "Mt" "tab") 10 anyfunc)
+    (func $f (result i32) (i32.const 0))
+    (elem (i32.const 7) $f)
+    (memory 1)
+    (data (i32.const 0x10000) "d") ;; out of bounds
+  )
+  "data segment does not fit"
+)
+(assert_trap (invoke $Mt "call" (i32.const 7)) "uninitialized")
+
 
 ;; Memories
 
@@ -239,3 +261,25 @@
   "unknown import"
 )
 (assert_return (invoke $Mm "load" (i32.const 0)) (i32.const 0))
+
+(assert_unlinkable
+  (module
+    (memory (import "Mm" "mem") 1)
+    (data (i32.const 0) "abc")
+    (data (i32.const 0x50000) "d") ;; out of bounds
+  )
+  "data segment does not fit"
+)
+(assert_return (invoke $Mm "load" (i32.const 0)) (i32.const 0))
+
+(assert_unlinkable
+  (module
+    (memory (import "Mm" "mem") 1)
+    (data (i32.const 0) "abc")
+    (table 0 anyfunc)
+    (func)
+    (elem (i32.const 0) 0) ;; out of bounds
+  )
+  "elements segment does not fit"
+)
+(assert_return (invoke $Mm "load" (i32.const 0)) (i32.const 0))

interpreter/test/memory.wast

@@ -53,6 +53,14 @@
   (module (memory 1 2) (data (i32.const 0) "a") (data (i32.const 98304) "b"))
   "data segment does not fit"
 )
+(assert_unlinkable
+  (module (memory 0 0) (data (i32.const 1) ""))
+  "data segment does not fit"
+)
+(assert_unlinkable
+  (module (memory 1) (data (i32.const 0x12000) ""))
+  "data segment does not fit"
+)
 ;; This seems to cause a time-out on Travis.
 (;assert_unlinkable
   (module (memory 0x10000) (data (i32.const 0xffffffff) "ab"))
@@ -64,7 +72,7 @@
 )
 
 (module (memory 0 0) (data (i32.const 0) ""))
-(module (memory 0 0) (data (i32.const 1) ""))
+(module (memory 1 1) (data (i32.const 0x10000) ""))
 (module (memory 1 2) (data (i32.const 0) "abc") (data (i32.const 0) "def"))
 (module (memory 1 2) (data (i32.const 3) "ab") (data (i32.const 0) "de"))
 (module