From a059c39db73e6f1e4bd8e38e179c73cbbff8a9cd Mon Sep 17 00:00:00 2001 From: Luke Wagner Date: Wed, 16 Sep 2015 18:22:20 -0500 Subject: [PATCH 1/4] Add linear memory resizing --- ml-proto/README.md | 6 +++++ ml-proto/src/Makefile | 4 +-- ml-proto/src/host/lexer.mll | 4 +++ ml-proto/src/host/params.ml | 1 + ml-proto/src/host/parser.mly | 4 +++ ml-proto/src/host/script.ml | 3 ++- ml-proto/src/spec/ast.ml | 3 +++ ml-proto/src/spec/check.ml | 10 +++++++ ml-proto/src/spec/eval.ml | 51 +++++++++++++++++++++++++++--------- ml-proto/src/spec/eval.mli | 6 ++++- ml-proto/src/spec/memory.ml | 26 +++++++++++++++--- ml-proto/src/spec/memory.mli | 2 ++ ml-proto/test/resizing.wasm | 32 ++++++++++++++++++++++ 13 files changed, 132 insertions(+), 20 deletions(-) create mode 100644 ml-proto/src/host/params.ml create mode 100644 ml-proto/test/resizing.wasm diff --git a/ml-proto/README.md b/ml-proto/README.md index 53e441a3ae..3d9267620a 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -135,6 +135,9 @@ type expr = | Binary of binop * expr * expr (* binary arithmetic operator | Compare of relop * expr * expr (* arithmetic comparison | Convert of cvt * expr (* conversion + | PageSize (* return host-defined page_size + | MemorySize (* return current size of linear memory + | ResizeMemory (* resize linear memory and arm = {value : value; expr : expr; fallthru : bool} ``` @@ -184,6 +187,9 @@ expr: ( . ) ( . ) ( ./ ) + ( page_size ) + ( memory_size ) + ( resize_memory ) case: ( case * fallthrough? ) ;; = (case (block *) fallthrough?) diff --git a/ml-proto/src/Makefile b/ml-proto/src/Makefile index 864e47b5c7..a08bad649f 100644 --- a/ml-proto/src/Makefile +++ b/ml-proto/src/Makefile @@ -5,13 +5,13 @@ NAME = wasm INCLUDES = -I host -I given -I spec MODULES = \ - host/flags given/lib given/source given/float32 given/float64 spec/error \ + host/params host/flags given/lib given/source given/float32 given/float64 spec/error \ spec/types spec/values spec/memory spec/ast \ spec/check spec/arithmetic spec/eval \ host/print host/builtins host/script \ host/lexer host/parser \ host/main -NOMLI = host/flags spec/types spec/values spec/ast host/main +NOMLI = host/params host/flags spec/types spec/values spec/ast host/main PARSERS = host/parser LEXERS = host/lexer LIBRARIES = bigarray nums str diff --git a/ml-proto/src/host/lexer.mll b/ml-proto/src/host/lexer.mll index 6d7bd75663..e8860a99af 100644 --- a/ml-proto/src/host/lexer.mll +++ b/ml-proto/src/host/lexer.mll @@ -235,6 +235,10 @@ rule token = parse | "i32.reinterpret/f32" { CONVERT (Values.Int32 Int32Op.ReinterpretFloat) } | "i64.reinterpret/f64" { CONVERT (Values.Int64 Int64Op.ReinterpretFloat) } + | "page_size" { PAGESIZE } + | "memory_size" { MEMORYSIZE } + | "resize_memory" { RESIZEMEMORY } + | "func" { FUNC } | "param" { PARAM } | "result" { RESULT } diff --git a/ml-proto/src/host/params.ml b/ml-proto/src/host/params.ml new file mode 100644 index 0000000000..e733d788fd --- /dev/null +++ b/ml-proto/src/host/params.ml @@ -0,0 +1 @@ +let page_size = 4096 diff --git a/ml-proto/src/host/parser.mly b/ml-proto/src/host/parser.mly index 35ca13d224..81ce2c72f4 100644 --- a/ml-proto/src/host/parser.mly +++ b/ml-proto/src/host/parser.mly @@ -103,6 +103,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels} %token GETLOCAL SETLOCAL LOADGLOBAL STOREGLOBAL LOAD STORE %token CONST UNARY BINARY COMPARE CONVERT %token FUNC PARAM RESULT LOCAL MODULE MEMORY SEGMENT GLOBAL IMPORT EXPORT TABLE +%token PAGESIZE MEMORYSIZE RESIZEMEMORY %token ASSERTINVALID ASSERTEQ ASSERTFAULT INVOKE %token EOF @@ -190,6 +191,9 @@ oper : | BINARY expr expr { fun c -> Binary ($1, $2 c, $3 c) } | COMPARE expr expr { fun c -> Compare ($1, $2 c, $3 c) } | CONVERT expr { fun c -> Convert ($1, $2 c) } + | PAGESIZE { fun c -> PageSize } + | MEMORYSIZE { fun c -> MemorySize } + | RESIZEMEMORY expr { fun c -> ResizeMemory ($2 c) } ; expr_opt : | /* empty */ { fun c -> None } diff --git a/ml-proto/src/host/script.ml b/ml-proto/src/host/script.ml index d32f91ad43..3c94a69487 100644 --- a/ml-proto/src/host/script.ml +++ b/ml-proto/src/host/script.ml @@ -49,7 +49,8 @@ let run_command cmd = end; trace "Initializing..."; let imports = Builtins.match_imports m.it.Ast.imports in - current_module := Some (Eval.init m imports) + let host_params = {Eval.page_size = Params.page_size} in + current_module := Some (Eval.init m imports host_params) | AssertInvalid (m, re) -> trace "Checking invalid..."; diff --git a/ml-proto/src/spec/ast.ml b/ml-proto/src/spec/ast.ml index 0630f4b770..39677ff863 100644 --- a/ml-proto/src/spec/ast.ml +++ b/ml-proto/src/spec/ast.ml @@ -96,6 +96,9 @@ and expr' = | Binary of binop * expr * expr | Compare of relop * expr * expr | Convert of cvt * expr + | PageSize + | MemorySize + | ResizeMemory of expr and arm = arm' Source.phrase and arm' = diff --git a/ml-proto/src/spec/check.ml b/ml-proto/src/spec/check.ml index f9442dcf9c..073d2ef33b 100644 --- a/ml-proto/src/spec/check.ml +++ b/ml-proto/src/spec/check.ml @@ -227,6 +227,16 @@ let rec check_expr c et e = check_expr c (Some t1) e1; check_type (Some t) et e.at + | PageSize -> + check_type (Some Int32Type) et e.at + + | MemorySize -> + check_type (Some Int32Type) et e.at + + | ResizeMemory e -> + check_expr c (Some Int32Type) e; + check_type None et e.at + and check_exprs c ts es = let ets = List.map (fun x -> Some x) ts in try List.iter2 (check_expr c) ets es diff --git a/ml-proto/src/spec/eval.ml b/ml-proto/src/spec/eval.ml index e5eac9bd49..d10b8e94fb 100644 --- a/ml-proto/src/spec/eval.ml +++ b/ml-proto/src/spec/eval.ml @@ -14,6 +14,10 @@ let error = Error.error type value = Values.value type func = Ast.func type import = value list -> value option +type host_params = +{ + page_size : Memory.size +} module ExportMap = Map.Make(String) type export_map = func ExportMap.t @@ -25,7 +29,8 @@ type instance = exports : export_map; tables : func list list; globals : value ref list; - memory : Memory.t + memory : Memory.t; + host : host_params } @@ -41,6 +46,9 @@ type config = return : label } +let page_size c = + Int32.of_int c.modul.host.page_size + let lookup category list x = try List.nth list x.it with Failure _ -> error x.at ("runtime: undefined " ^ category ^ " " ^ string_of_int x.it) @@ -204,6 +212,19 @@ let rec eval_expr (c : config) (e : expr) = (try Some (Arithmetic.eval_cvt cvt v1) with Arithmetic.TypeError (_, v, t) -> type_error e1.at v t) + | PageSize -> + Some (Int32 (page_size c)) + + | MemorySize -> + Some (Int32 (Int32.of_int (Memory.size c.modul.memory))) + + | ResizeMemory e -> + let i = int32 (eval_expr c e) e.at in + if (Int32.rem i (page_size c)) <> Int32.zero then + error e.at "runtime: resize_memory operand not multiple of page_size"; + Memory.resize c.modul.memory (Int32.to_int i); + None + and eval_expr_option c eo = match eo with | Some e -> eval_expr c e @@ -234,31 +255,37 @@ and eval_func (m : instance) (f : func) (evs : value list) = (* Modules *) -let init m imports = +let init_memory ast = + match ast with + | None -> + Memory.create 0 + | Some {it = {initial; segments; _}} -> + let mem = Memory.create initial in + Memory.init mem (List.map it segments); + mem + +let init m imports host = assert (List.length imports = List.length m.it.Ast.imports); + assert (host.page_size > 0); let {Ast.exports; globals; tables; funcs; memory; _} = m.it in - let mem = - match memory with - | None -> Memory.create 0 - | Some {it = {initial; segments; _}} -> - let mem = Memory.create initial in - Memory.init mem (List.map it segments); - mem - in + let memory = init_memory memory in let func x = List.nth funcs x.it in let export ex = ExportMap.add ex.it.name (func ex.it.func) in let exports = List.fold_right export exports ExportMap.empty in let tables = List.map (fun tab -> List.map func tab.it) tables in let globals = List.map eval_decl globals in - {funcs; imports; exports; tables; globals; memory = mem} + {funcs; imports; exports; tables; globals; memory; host} let invoke m name vs = let f = export m (name @@ no_region) in + assert (List.length vs = List.length f.it.params); eval_func m f vs let eval e = let f = {params = []; result = None; locals = []; body = e} @@ no_region in let memory = Memory.create 0 in let exports = ExportMap.singleton "eval" f in - let m = {imports = []; exports; globals = []; tables = []; funcs = [f]; memory} in + let host = {page_size = 1} in + let m = {imports = []; exports; globals = []; tables = []; funcs = [f]; + memory; host} in eval_func m f [] diff --git a/ml-proto/src/spec/eval.mli b/ml-proto/src/spec/eval.mli index dc855592b2..d4339cd5b9 100644 --- a/ml-proto/src/spec/eval.mli +++ b/ml-proto/src/spec/eval.mli @@ -5,8 +5,12 @@ type instance type value = Values.value type import = value list -> value option +type host_params = +{ + page_size : Memory.size +} -val init : Ast.modul -> import list -> instance +val init : Ast.modul -> import list -> host_params -> instance val invoke : instance -> string -> value list -> value option (* raise Error.Error *) val eval : Ast.expr -> value option (* raise Error.Error *) diff --git a/ml-proto/src/spec/memory.ml b/ml-proto/src/spec/memory.ml index 00f3f745ec..00520ec525 100644 --- a/ml-proto/src/spec/memory.ml +++ b/ml-proto/src/spec/memory.ml @@ -20,7 +20,8 @@ type segment = data : string } -type memory = (int, int8_unsigned_elt, c_layout) Array1.t +type memory' = (int, int8_unsigned_elt, c_layout) Array1.t +type memory = memory' ref type t = memory type char_view = (char, int8_unsigned_elt, c_layout) Array1.t @@ -35,7 +36,7 @@ type uint64_view = (int64, int64_elt, c_layout) Array1.t type float32_view = (int32, int32_elt, c_layout) Array1.t type float64_view = (int64, int64_elt, c_layout) Array1.t -let view : memory -> ('c, 'd, c_layout) Array1.t = Obj.magic +let view : memory' -> ('c, 'd, c_layout) Array1.t = Obj.magic (* Queries *) @@ -53,12 +54,16 @@ exception Type exception Bounds exception Address -let create n = +let create' n = let mem = Array1.create Int8_unsigned C_layout n in Array1.fill mem 0; mem +let create n = + ref (create' n) + let init_seg mem seg = + let mem = !mem in (* There currently is no way to blit from a string. *) for i = 0 to String.length seg.data - 1 do (view mem : char_view).{seg.addr + i} <- seg.data.[i] @@ -68,6 +73,17 @@ let init mem segs = try List.iter (init_seg mem) segs with Invalid_argument _ -> raise Bounds +let size mem = + let mem = !mem in + Array1.dim mem + +let resize mem n = + let before = !mem in + let after = create' n in + let min = min (Array1.dim before) n in + Array1.blit (Array1.sub before 0 min) (Array1.sub after 0 min); + mem := after + open Values let address_of_value = function @@ -80,9 +96,10 @@ let address_of_value = function let int32_mask = Int64.shift_right_logical (Int64.of_int (-1)) 32 let int64_of_int32_u i = Int64.logand (Int64.of_int32 i) int32_mask -let buf = create 8 +let buf = create' 8 let load mem a memty ext = + let mem = !mem in let sz = mem_size memty in let open Types in try @@ -100,6 +117,7 @@ let load mem a memty ext = with Invalid_argument _ -> raise Bounds let store mem a memty v = + let mem = !mem in let sz = mem_size memty in try (match memty, v with diff --git a/ml-proto/src/spec/memory.mli b/ml-proto/src/spec/memory.mli index 72e91ec809..08cba1bc18 100644 --- a/ml-proto/src/spec/memory.mli +++ b/ml-proto/src/spec/memory.mli @@ -19,6 +19,8 @@ exception Address val create : size -> memory val init : memory -> segment list -> unit +val size : memory -> size +val resize : memory -> size -> unit val load : memory -> address -> mem_type -> extension -> Values.value val store : memory -> address -> mem_type -> Values.value -> unit diff --git a/ml-proto/test/resizing.wasm b/ml-proto/test/resizing.wasm new file mode 100644 index 0000000000..7a350371f2 --- /dev/null +++ b/ml-proto/test/resizing.wasm @@ -0,0 +1,32 @@ +(module + (memory 4096) + + (export "load" $load) + (func $load (param $i i32) (result i32) (i32.load (get_local $i))) + + (export "store" $store) + (func $store (param $i i32) (param $v i32) (i32.store (get_local $i) (get_local $v))) + + (export "resize" $resize) + (func $resize (param $sz i32) (resize_memory (get_local $sz))) + + (export "size" $size) + (func $size (result i32) (memory_size)) +) + +(assert_eq (invoke "size") (i32.const 4096)) +(invoke "store" (i32.const 0) (i32.const 42)) +(assert_eq (invoke "load" (i32.const 0)) (i32.const 42)) +(assert_fault (invoke "store" (i32.const 4096) (i32.const 42)) "runtime: out of bounds memory access") +(assert_fault (invoke "load" (i32.const 4096)) "runtime: out of bounds memory access") +(invoke "resize" (i32.const 8192)) +(assert_eq (invoke "size") (i32.const 8192)) +(assert_eq (invoke "load" (i32.const 0)) (i32.const 42)) +(assert_eq (invoke "load" (i32.const 4096)) (i32.const 0)) +(invoke "store" (i32.const 4096) (i32.const 43)) +(assert_eq (invoke "load" (i32.const 4096)) (i32.const 43)) +(invoke "resize" (i32.const 4096)) +(assert_eq (invoke "size") (i32.const 4096)) +(assert_eq (invoke "load" (i32.const 0)) (i32.const 42)) +(assert_fault (invoke "store" (i32.const 4096) (i32.const 42)) "runtime: out of bounds memory access") +(assert_fault (invoke "load" (i32.const 4096)) "runtime: out of bounds memory access") From 5ef1a3a266d4283315b364b925cd717b6746ff88 Mon Sep 17 00:00:00 2001 From: Luke Wagner Date: Thu, 17 Sep 2015 10:32:20 -0500 Subject: [PATCH 2/4] Address feedback --- ml-proto/src/spec/eval.ml | 9 +++------ ml-proto/src/spec/eval.mli | 5 +---- ml-proto/src/spec/memory.ml | 12 ++++-------- 3 files changed, 8 insertions(+), 18 deletions(-) diff --git a/ml-proto/src/spec/eval.ml b/ml-proto/src/spec/eval.ml index d10b8e94fb..4cc8ce6082 100644 --- a/ml-proto/src/spec/eval.ml +++ b/ml-proto/src/spec/eval.ml @@ -14,10 +14,7 @@ let error = Error.error type value = Values.value type func = Ast.func type import = value list -> value option -type host_params = -{ - page_size : Memory.size -} +type host_params = { page_size : Memory.size } module ExportMap = Map.Make(String) type export_map = func ExportMap.t @@ -268,13 +265,13 @@ let init m imports host = assert (List.length imports = List.length m.it.Ast.imports); assert (host.page_size > 0); let {Ast.exports; globals; tables; funcs; memory; _} = m.it in - let memory = init_memory memory in + let mem = init_memory memory in let func x = List.nth funcs x.it in let export ex = ExportMap.add ex.it.name (func ex.it.func) in let exports = List.fold_right export exports ExportMap.empty in let tables = List.map (fun tab -> List.map func tab.it) tables in let globals = List.map eval_decl globals in - {funcs; imports; exports; tables; globals; memory; host} + {funcs; imports; exports; tables; globals; memory = mem; host} let invoke m name vs = let f = export m (name @@ no_region) in diff --git a/ml-proto/src/spec/eval.mli b/ml-proto/src/spec/eval.mli index d4339cd5b9..0da6a7356e 100644 --- a/ml-proto/src/spec/eval.mli +++ b/ml-proto/src/spec/eval.mli @@ -5,10 +5,7 @@ type instance type value = Values.value type import = value list -> value option -type host_params = -{ - page_size : Memory.size -} +type host_params = { page_size : Memory.size } val init : Ast.modul -> import list -> host_params -> instance val invoke : instance -> string -> value list -> value option diff --git a/ml-proto/src/spec/memory.ml b/ml-proto/src/spec/memory.ml index 00520ec525..b953a1e205 100644 --- a/ml-proto/src/spec/memory.ml +++ b/ml-proto/src/spec/memory.ml @@ -63,10 +63,9 @@ let create n = ref (create' n) let init_seg mem seg = - let mem = !mem in (* There currently is no way to blit from a string. *) for i = 0 to String.length seg.data - 1 do - (view mem : char_view).{seg.addr + i} <- seg.data.[i] + (view !mem : char_view).{seg.addr + i} <- seg.data.[i] done let init mem segs = @@ -74,8 +73,7 @@ let init mem segs = let size mem = - let mem = !mem in - Array1.dim mem + Array1.dim !mem let resize mem n = let before = !mem in @@ -99,11 +97,10 @@ let int64_of_int32_u i = Int64.logand (Int64.of_int32 i) int32_mask let buf = create' 8 let load mem a memty ext = - let mem = !mem in let sz = mem_size memty in let open Types in try - Array1.blit (Array1.sub mem a sz) (Array1.sub buf 0 sz); + Array1.blit (Array1.sub !mem a sz) (Array1.sub buf 0 sz); match memty, ext with | Int8Mem, SX -> Int32 (Int32.of_int (view buf : sint8_view).{0}) | Int8Mem, ZX -> Int32 (Int32.of_int (view buf : uint8_view).{0}) @@ -117,7 +114,6 @@ let load mem a memty ext = with Invalid_argument _ -> raise Bounds let store mem a memty v = - let mem = !mem in let sz = mem_size memty in try (match memty, v with @@ -128,5 +124,5 @@ let store mem a memty v = | Float32Mem, Float32 x -> (view buf : float32_view).{0} <- Float32.to_bits x | Float64Mem, Float64 x -> (view buf : float64_view).{0} <- Float64.to_bits x | _ -> raise Type); - Array1.blit (Array1.sub buf 0 sz) (Array1.sub mem a sz) + Array1.blit (Array1.sub buf 0 sz) (Array1.sub !mem a sz) with Invalid_argument _ -> raise Bounds From 5cab421b3a0af9910587ee40ebcdffb603564053 Mon Sep 17 00:00:00 2001 From: Luke Wagner Date: Thu, 17 Sep 2015 10:54:53 -0500 Subject: [PATCH 3/4] Note power-of-2 requirement to match new design text --- ml-proto/src/spec/eval.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/ml-proto/src/spec/eval.ml b/ml-proto/src/spec/eval.ml index 4cc8ce6082..86b0dd305c 100644 --- a/ml-proto/src/spec/eval.ml +++ b/ml-proto/src/spec/eval.ml @@ -264,6 +264,7 @@ let init_memory ast = let init m imports host = assert (List.length imports = List.length m.it.Ast.imports); assert (host.page_size > 0); + assert (Lib.Int.is_power_of_two host.page_size); let {Ast.exports; globals; tables; funcs; memory; _} = m.it in let mem = init_memory memory in let func x = List.nth funcs x.it in From b54625bfc62f36e19741d65760d97c346676cfdc Mon Sep 17 00:00:00 2001 From: Luke Wagner Date: Thu, 17 Sep 2015 11:03:20 -0500 Subject: [PATCH 4/4] Address nits --- ml-proto/src/spec/eval.ml | 2 +- ml-proto/src/spec/eval.mli | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ml-proto/src/spec/eval.ml b/ml-proto/src/spec/eval.ml index 86b0dd305c..a9d81d8136 100644 --- a/ml-proto/src/spec/eval.ml +++ b/ml-proto/src/spec/eval.ml @@ -14,7 +14,7 @@ let error = Error.error type value = Values.value type func = Ast.func type import = value list -> value option -type host_params = { page_size : Memory.size } +type host_params = {page_size : Memory.size} module ExportMap = Map.Make(String) type export_map = func ExportMap.t diff --git a/ml-proto/src/spec/eval.mli b/ml-proto/src/spec/eval.mli index 0da6a7356e..f6f6c70fa4 100644 --- a/ml-proto/src/spec/eval.mli +++ b/ml-proto/src/spec/eval.mli @@ -5,7 +5,7 @@ type instance type value = Values.value type import = value list -> value option -type host_params = { page_size : Memory.size } +type host_params = {page_size : Memory.size} val init : Ast.modul -> import list -> host_params -> instance val invoke : instance -> string -> value list -> value option