diff --git a/ml-proto/README.md b/ml-proto/README.md index c2ae699446..d03ec581d6 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -118,7 +118,7 @@ expr: ( . ) ( ./ ) ( unreachable ) - ( memory_size ) + ( current_memory ) ( grow_memory ) func: ( func ? ? * ? * * ) diff --git a/ml-proto/host/lexer.mll b/ml-proto/host/lexer.mll index 0e96393989..2d0c5fd9e0 100644 --- a/ml-proto/host/lexer.mll +++ b/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 } diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index b706a6c2e4..529a4fbfa7 100644 --- a/ml-proto/host/parser.mly +++ b/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 : diff --git a/ml-proto/spec/ast.ml b/ml-proto/spec/ast.ml index 01a653c573..86b1a71166 100644 --- a/ml-proto/spec/ast.ml +++ b/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 diff --git a/ml-proto/spec/check.ml b/ml-proto/spec/check.ml index 9280948c54..573863f2d9 100644 --- a/ml-proto/spec/check.ml +++ b/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) diff --git a/ml-proto/spec/desugar.ml b/ml-proto/spec/desugar.ml index 28e8c54a9a..1d3b722d77 100644 --- a/ml-proto/spec/desugar.ml +++ b/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 diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index 459b634d59..3dfadc27db 100644 --- a/ml-proto/spec/eval.ml +++ b/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. diff --git a/ml-proto/spec/kernel.ml b/ml-proto/spec/kernel.ml index 03ab828e45..c57a37569c 100644 --- a/ml-proto/spec/kernel.ml +++ b/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 *) diff --git a/ml-proto/spec/memory.ml b/ml-proto/spec/memory.ml index c8fb8e3e07..4f6e75f8d5 100644 --- a/ml-proto/spec/memory.ml +++ b/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 diff --git a/ml-proto/test/memory_trap.wast b/ml-proto/test/memory_trap.wast index 18d8a53397..4894d7098b 100644 --- a/ml-proto/test/memory_trap.wast +++ b/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") diff --git a/ml-proto/test/resizing.wast b/ml-proto/test/resizing.wast index 727f23847c..1a1073cdc9 100644 --- a/ml-proto/test/resizing.wast +++ b/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))