Make grow_memory and return pages, and replace memory_size with current_memory

ml-proto/README.md

@@ -118,7 +118,7 @@ expr:
   ( <type>.<relop> <expr> <expr> )
   ( <type>.<cvtop>/<type> <expr> )
   ( unreachable )
-  ( memory_size )
+  ( current_memory )
   ( grow_memory <expr> )
 
 func:   ( func <name>? <type>? <param>* <result>? <local>* <expr>* )

ml-proto/host/lexer.mll

@@ -345,7 +345,7 @@ rule token = parse
   | "i32.reinterpret/f32" { CONVERT (fun e -> I32_reinterpret_f32 e) }
   | "i64.reinterpret/f64" { CONVERT (fun e -> I64_reinterpret_f64 e) }
 
-  | "memory_size" { MEMORY_SIZE }
+  | "current_memory" { CURRENT_MEMORY }
   | "grow_memory" { GROW_MEMORY }
 
   | "type" { TYPE }

ml-proto/host/parser.mly

@@ -129,9 +129,9 @@ let implicit_decl c t at =
 %token CALL CALL_IMPORT CALL_INDIRECT RETURN
 %token GET_LOCAL SET_LOCAL LOAD STORE OFFSET ALIGN
 %token CONST UNARY BINARY COMPARE CONVERT
+%token UNREACHABLE CURRENT_MEMORY GROW_MEMORY
 %token FUNC START TYPE PARAM RESULT LOCAL
 %token MODULE MEMORY SEGMENT IMPORT EXPORT TABLE
-%token UNREACHABLE MEMORY_SIZE GROW_MEMORY
 %token ASSERT_INVALID ASSERT_RETURN ASSERT_RETURN_NAN ASSERT_TRAP INVOKE
 %token EOF
 
@@ -257,7 +257,7 @@ expr1 :
   | TEST expr { fun c -> $1 ($2 c) }
   | COMPARE expr expr { fun c -> $1 ($2 c, $3 c) }
   | CONVERT expr { fun c -> $1 ($2 c) }
-  | MEMORY_SIZE { fun c -> Memory_size }
+  | CURRENT_MEMORY { fun c -> Current_memory }
   | GROW_MEMORY expr { fun c -> Grow_memory ($2 c) }
 ;
 expr_opt :

ml-proto/spec/ast.ml

@@ -191,7 +191,7 @@ and expr' =
   | F64_reinterpret_i64 of expr
 
   (* Host queries *)
-  | Memory_size
+  | Current_memory
   | Grow_memory of expr
 
 

ml-proto/spec/check.ml

@@ -92,7 +92,7 @@ let type_cvtop at = function
  * present in the module.
  *)
 let type_hostop = function
-  | MemorySize -> ({ins = []; out = Some Int32Type}, true)
+  | CurrentMemory -> ({ins = []; out = Some Int32Type}, true)
   | GrowMemory -> ({ins = [Int32Type]; out = Some Int32Type}, true)
 
 

ml-proto/spec/desugar.ml

@@ -281,7 +281,7 @@ and expr' at = function
   | Ast.F32_reinterpret_i32 e -> Convert (Float32 F32Op.ReinterpretInt, expr e)
   | Ast.F64_reinterpret_i64 e -> Convert (Float64 F64Op.ReinterpretInt, expr e)
 
-  | Ast.Memory_size -> Host (MemorySize, [])
+  | Ast.Current_memory -> Host (CurrentMemory, [])
   | Ast.Grow_memory e -> Host (GrowMemory, [expr e])
 
 and seq = function

ml-proto/spec/eval.ml

@@ -276,16 +276,17 @@ and coerce et vo =
 
 and eval_hostop c hostop vs at =
   match hostop, vs with
-  | MemorySize, [] ->
+  | CurrentMemory, [] ->
     let mem = memory c at in
-    assert (I64.lt_u (Memory.size mem) (Int64.of_int32 Int32.max_int));
-    Some (Int32 (Int64.to_int32 (Memory.size mem)))
+    let size = Memory.size mem in
+    assert (I64.lt_u size (Int64.of_int32 Int32.max_int));
+    Some (Int32 (Int64.to_int32 size))
 
   | GrowMemory, [v] ->
     let mem = memory c at in
     let delta = address32 v at in
     let old_size = Memory.size mem in
-    let new_size = Int64.(add old_size (mul delta Memory.page_size)) in
+    let new_size = Int64.add old_size delta in
     if I64.lt_u new_size old_size then
       Trap.error at "memory size overflow";
     (* Test whether the new size overflows the memory type.

ml-proto/spec/kernel.ml

@@ -65,7 +65,7 @@ type memop = {ty : value_type; offset : Memory.offset; align : int}
 type extop = {memop : memop; sz : Memory.mem_size; ext : Memory.extension}
 type wrapop = {memop : memop; sz : Memory.mem_size}
 type hostop =
-  | MemorySize           (* inquire current size of linear memory *)
+  | CurrentMemory        (* inquire current size of linear memory *)
   | GrowMemory           (* grow linear memory *)
 
 

ml-proto/spec/memory.ml

@@ -28,7 +28,7 @@ let page_size = 0x10000L (* 64 KiB *)
  *)
 
 let host_size_of_int64 n =
-  if n < Int64.zero || n > (Int64.of_int max_int) then raise Out_of_memory;
+  if n < 0L || n > Int64.of_int max_int then raise Out_of_memory;
   Int64.to_int n
 
 let int64_of_host_size n =
@@ -66,14 +66,14 @@ let init mem segs =
   try List.iter (init_seg mem) segs with Invalid_argument _ -> raise Bounds
 
 let size mem =
-  int64_of_host_size (Array1.dim !mem)
+  Int64.div (int64_of_host_size (Array1.dim !mem)) page_size
 
 let grow mem pages =
-  let old_size = Int64.div (size mem) page_size in
+  let host_old_size = Array1.dim !mem in
+  let old_size = size mem in
   let new_size = Int64.add old_size pages in
   if I64.gt_u old_size new_size then raise SizeOverflow else
   let after = create' new_size in
-  let host_old_size = host_size_of_int64 old_size in
   Array1.blit (Array1.sub !mem 0 host_old_size) (Array1.sub after 0 host_old_size);
   mem := after
 

ml-proto/test/memory_trap.wast

@@ -1,19 +1,23 @@
 (module
     (memory 1)
 
+    (func $addr_limit (result i32)
+      (i32.mul (current_memory) (i32.const 0x10000))
+    )
+
     (export "store" $store)
     (func $store (param $i i32) (param $v i32) (result i32)
-      (i32.store (i32.add (memory_size) (get_local $i)) (get_local $v))
+      (i32.store (i32.add (call $addr_limit) (get_local $i)) (get_local $v))
     )
 
     (export "load" $load)
     (func $load (param $i i32) (result i32)
-      (i32.load (i32.add (memory_size) (get_local $i)))
+      (i32.load (i32.add (call $addr_limit) (get_local $i)))
     )
 
-    (export "overflow_memory_size" $overflow_memory_size)
-    (func $overflow_memory_size
-      (grow_memory (i32.xor (i32.const -1) (i32.sub (i32.const 0x10000) (i32.const 1))))
+    (export "grow_memory" $grow_memory)
+    (func $grow_memory (param i32)
+      (grow_memory (get_local 0))
     )
 )
 
@@ -29,4 +33,4 @@
 (assert_trap (invoke "load" (i32.const 0)) "out of bounds memory access")
 (assert_trap (invoke "store" (i32.const 0x80000000) (i32.const 13)) "out of bounds memory access")
 (assert_trap (invoke "load" (i32.const 0x80000000)) "out of bounds memory access")
-(assert_trap (invoke "overflow_memory_size") "memory size exceeds implementation limit")
+(assert_trap (invoke "grow_memory" (i32.const 0x80000000)) "memory size exceeds implementation limit")

ml-proto/test/resizing.wast

@@ -17,7 +17,7 @@
     (func $grow (param $sz i32) (result i32) (grow_memory (get_local $sz)))
 
     (export "size" $size)
-    (func $size (result i32) (memory_size))
+    (func $size (result i32) (current_memory))
 )
 
 (assert_return (invoke "size") (i32.const 0))
@@ -26,14 +26,14 @@
 (assert_trap (invoke "store_at_page_size") "out of bounds memory access")
 (assert_trap (invoke "load_at_page_size") "out of bounds memory access")
 (assert_return (invoke "grow" (i32.const 1)) (i32.const 0))
-(assert_return (invoke "size") (i32.const 0x10000))
+(assert_return (invoke "size") (i32.const 1))
 (assert_return (invoke "load_at_zero") (i32.const 0))
 (assert_return (invoke "store_at_zero") (i32.const 2))
 (assert_return (invoke "load_at_zero") (i32.const 2))
 (assert_trap (invoke "store_at_page_size") "out of bounds memory access")
 (assert_trap (invoke "load_at_page_size") "out of bounds memory access")
-(assert_return (invoke "grow" (i32.const 4)) (i32.const 0x10000))
-(assert_return (invoke "size") (i32.const 0x50000))
+(assert_return (invoke "grow" (i32.const 4)) (i32.const 1))
+(assert_return (invoke "size") (i32.const 5))
 (assert_return (invoke "load_at_zero") (i32.const 2))
 (assert_return (invoke "store_at_zero") (i32.const 2))
 (assert_return (invoke "load_at_page_size") (i32.const 0))