diff --git a/src/lib_lazy_containers/lazy_map.ml b/src/lib_lazy_containers/lazy_map.ml index b6f4fdb1d95838161d2e77758a4361b82d6b033d..335219bd14451821d6a6f7abc818e49c260959c6 100644 --- a/src/lib_lazy_containers/lazy_map.ml +++ b/src/lib_lazy_containers/lazy_map.ml @@ -59,6 +59,8 @@ module type S = sig val set : key -> 'a -> 'a t -> 'a t + val dup : 'a t -> 'a t + val loaded_bindings : 'a t -> (key * 'a) list end @@ -121,6 +123,8 @@ module Make (Key : KeyS) : S with type key = Key.t = struct let set key value map = {map with values = Map.add key value map.values} + let dup {origin; produce_value; values} = {origin; produce_value; values} + let loaded_bindings m = Map.bindings m.values end diff --git a/src/lib_lazy_containers/lazy_map.mli b/src/lib_lazy_containers/lazy_map.mli index 9be2221cccaf284d744a12336fd7236b40870b07..61607c4da19f1e82d256f9e2e5dbb3253dc00229 100644 --- a/src/lib_lazy_containers/lazy_map.mli +++ b/src/lib_lazy_containers/lazy_map.mli @@ -95,6 +95,17 @@ module type S = sig @raises Exn.Bounds when trying to set an invalid key *) val set : key -> 'a -> 'a t -> 'a t + (** [dup map] duplicates [map]. + + {b Note:} the [produce_value] continuation is shared between the + resulting map and [map], meaning that if said continuation + carries a state, the two maps will interfere with each + others. This is safe when used in conjunction with + [lib_tree_encoding], because the continuation is pure in the + sense it will always returns the same result when called with + the same argument. *) + val dup : 'a t -> 'a t + (** [loaded_bindings map] returns the [(key * 'a) list] representation of the map [map] containing only the loaded values, in order of increasing keys. This function is a witness of internal mutations. *) diff --git a/src/lib_lazy_containers/lazy_vector.ml b/src/lib_lazy_containers/lazy_vector.ml index 6bcff95a25c6aa62bf4e85ef8480c6b22dc3ed44..5c99aaf2a1398c1537b1f7fed5040c42727fe5f8 100644 --- a/src/lib_lazy_containers/lazy_vector.ml +++ b/src/lib_lazy_containers/lazy_vector.ml @@ -84,10 +84,14 @@ module type S = sig val cons : 'a -> 'a t -> 'a t + val split : 'a t -> key -> 'a t * 'a t + val grow : ?default:(unit -> 'a) -> key -> 'a t -> 'a t val pop : 'a t -> ('a * 'a t) Lwt.t + val prepend_list : 'a list -> 'a t -> 'a t + val append : 'a -> 'a t -> 'a t * key val concat : 'a t -> 'a t -> 'a t Lwt.t @@ -176,6 +180,20 @@ module Make (Key : KeyS) : S with type key = Key.t = struct let num_elements = Key.succ map.num_elements in {first; values; num_elements} + let split vec at = + if + Key.( + unsigned_compare at zero < 0 + || unsigned_compare (num_elements vec) at < 0) + then raise Bounds + else + ( {first = vec.first; num_elements = at; values = Map.dup vec.values}, + { + first = Key.(add vec.first at); + num_elements = Key.(sub vec.num_elements at); + values = Map.dup vec.values; + } ) + let append_opt elt map = let num_elements = map.num_elements in let map = {map with num_elements = Key.succ num_elements} in @@ -198,6 +216,11 @@ module Make (Key : KeyS) : S with type key = Key.t = struct let append elt map = append_opt (Some elt) map + let prepend_list es es0 = + let es = List.rev es in + let rec aux v = function x :: rst -> aux (cons x v) rst | [] -> v in + aux es0 es + let rec grow ?default delta map = if Key.(delta <= zero) then map else diff --git a/src/lib_lazy_containers/lazy_vector.mli b/src/lib_lazy_containers/lazy_vector.mli index 46cf1a1e3d0089d888942c04cfee3374c587954f..94de867bf6f733d5220906315917a793240974b0 100644 --- a/src/lib_lazy_containers/lazy_vector.mli +++ b/src/lib_lazy_containers/lazy_vector.mli @@ -137,6 +137,14 @@ module type S = sig one. That value can then be accessed using the [zero] key. *) val cons : 'a -> 'a t -> 'a t + (** [split vec at] splits [vec] into two sub vectors at element + [at]. The first vector has [at] elements, the second [length vec + - at] elements. + + @raise Bounds when [at < 0] + @raise Bounds when [at > num_elements vec] *) + val split : 'a t -> key -> 'a t * 'a t + (** [grow delta ?default vector] creates a new lazy vector that has [delta] more items than [vector]. This also retains all values that have previously been created. New values will be created with [default] @@ -152,6 +160,12 @@ module type S = sig @raise Bounds when applied on an empty vector. *) val pop : 'a t -> ('a * 'a t) Lwt.t + (** [prepend_list l vec] adds the elements of [l] at the front of [vec]. + + {b Note:} This function may be dangerous to use in a tick, if + [List.length l] is significant. *) + val prepend_list : 'a list -> 'a t -> 'a t + (** [append elt vector] creates a new lazy vector that has one more item than [vector] whose value is [elt]. This is a shortcut for [vector |> grow Key.(succ zero) |> set (num_elements vector) elt]. diff --git a/src/lib_scoru_wasm/binary_parser_encodings.ml b/src/lib_scoru_wasm/binary_parser_encodings.ml index 4fb10e5ced3596c1346bbdb9dcdfcb9035a22a6a..000a614712c01b612c6095424878e23085ed654d 100644 --- a/src/lib_scoru_wasm/binary_parser_encodings.ml +++ b/src/lib_scoru_wasm/binary_parser_encodings.ml @@ -1117,17 +1117,33 @@ module Module = struct let func_kont = scope ["func_kont"] (Lazy_vec.encoding Code.func_encoding) in + let instr_kont = + scope + ["instr_kont"] + (option + (Lazy_vec.encoding + (Lazy_vec.encoding Wasm_encoding.instruction_encoding))) + in let no_datas_in_func = value ["no-datas-in-funcs"] Data_encoding.bool in case "MKElaborateFunc" - (tup4 ~flatten:true func_types func_bodies func_kont no_datas_in_func) + (tup5 + ~flatten:true + func_types + func_bodies + func_kont + instr_kont + no_datas_in_func) (function | Decode.MKElaborateFunc - (func_types, func_bodies, func_kont, no_datas_in_func) -> - Some (func_types, func_bodies, func_kont, no_datas_in_func) + (func_types, func_bodies, func_kont, instr_kont, no_datas_in_func) + -> + Some + (func_types, func_bodies, func_kont, instr_kont, no_datas_in_func) | _ -> None) - (fun (func_types, func_bodies, func_kont, no_datas_in_func) -> - MKElaborateFunc (func_types, func_bodies, func_kont, no_datas_in_func)) + (fun (func_types, func_bodies, func_kont, instr_kont, no_datas_in_func) -> + MKElaborateFunc + (func_types, func_bodies, func_kont, instr_kont, no_datas_in_func)) let module_funcs_encoding = scope ["module"; "funcs"] (vector_encoding Code.func_encoding) diff --git a/src/lib_scoru_wasm/init_encodings.ml b/src/lib_scoru_wasm/init_encodings.ml index 63c82693d2f24f3d821a1ec4c5d5fdb26f2a05da..4870308e3f67cbe3d994d7f27377c704773dfa51 100644 --- a/src/lib_scoru_wasm/init_encodings.ml +++ b/src/lib_scoru_wasm/init_encodings.ml @@ -26,58 +26,10 @@ open Tezos_webassembly_interpreter.Eval module Parser = Binary_parser_encodings open Tree_encoding +open Kont_encodings let tag_encoding = value [] Data_encoding.string -let fold_right2_kont_encoding enc_a enc_b enc_acc = - conv - (fun (acc, lv, rv, offset) -> {acc; lv; rv; offset}) - (fun {acc; lv; rv; offset} -> (acc, lv, rv, offset)) - @@ tup4 - ~flatten:true - (scope ["acc"] enc_acc) - (scope ["left_vector"] enc_a) - (scope ["right_vector"] enc_b) - (value ["offset"] @@ Data_encoding.int32) - -let map_kont_encoding enc_a enc_b = - conv - (fun (origin, destination, offset) -> {origin; destination; offset}) - (fun {origin; destination; offset} -> (origin, destination, offset)) - @@ tup3 - ~flatten:true - (scope ["origin"] enc_a) - (scope ["destination"] enc_b) - (value ["offset"] Data_encoding.int32) - -let tick_map_kont_encoding enc_kont enc_a enc_b = - conv (fun (tick, map) -> {tick; map}) (fun {tick; map} -> (tick, map)) - @@ tup2 - ~flatten:true - (option (scope ["inner_kont"] enc_kont)) - (scope ["map_kont"] (map_kont_encoding enc_a enc_b)) - -let concat_kont_encoding enc_a = - conv - (fun (lv, rv, res, offset) -> {lv; rv; res; offset}) - (fun {lv; rv; res; offset} -> (lv, rv, res, offset)) - @@ tup4 - ~flatten:true - (scope ["lv"] enc_a) - (scope ["rv"] enc_a) - (scope ["res"] enc_a) - (value ["offset"] Data_encoding.int32) - -let fold_left_kont_encoding enc_a enc_acc = - conv - (fun (origin, acc, offset) -> {origin; acc; offset}) - (fun {origin; acc; offset} -> (origin, acc, offset)) - @@ tup3 - ~flatten:true - (scope ["origin"] enc_a) - (scope ["acc"] enc_acc) - (value ["offset"] Data_encoding.int32) - let lazy_vec_encoding enc = int32_lazy_vector (value [] Data_encoding.int32) enc let eval_const_kont_encoding ~host_funcs = diff --git a/src/lib_scoru_wasm/kont_encodings.ml b/src/lib_scoru_wasm/kont_encodings.ml new file mode 100644 index 0000000000000000000000000000000000000000..380b5282962785ff71f00aea492159fa5e362d00 --- /dev/null +++ b/src/lib_scoru_wasm/kont_encodings.ml @@ -0,0 +1,76 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +open Tezos_webassembly_interpreter.Eval +open Tree_encoding + +let fold_right2_kont_encoding enc_a enc_b enc_acc = + conv + (fun (acc, lv, rv, offset) -> {acc; lv; rv; offset}) + (fun {acc; lv; rv; offset} -> (acc, lv, rv, offset)) + @@ tup4 + ~flatten:true + (scope ["acc"] enc_acc) + (scope ["left_vector"] enc_a) + (scope ["right_vector"] enc_b) + (value ["offset"] @@ Data_encoding.int32) + +let map_kont_encoding enc_a enc_b = + conv + (fun (origin, destination, offset) -> {origin; destination; offset}) + (fun {origin; destination; offset} -> (origin, destination, offset)) + @@ tup3 + ~flatten:true + (scope ["origin"] enc_a) + (scope ["destination"] enc_b) + (value ["offset"] Data_encoding.int32) + +let tick_map_kont_encoding enc_kont enc_a enc_b = + conv (fun (tick, map) -> {tick; map}) (fun {tick; map} -> (tick, map)) + @@ tup2 + ~flatten:true + (option (scope ["inner_kont"] enc_kont)) + (scope ["map_kont"] (map_kont_encoding enc_a enc_b)) + +let concat_kont_encoding enc_a = + conv + (fun (lv, rv, res, offset) -> {lv; rv; res; offset}) + (fun {lv; rv; res; offset} -> (lv, rv, res, offset)) + @@ tup4 + ~flatten:true + (scope ["lv"] enc_a) + (scope ["rv"] enc_a) + (scope ["res"] enc_a) + (value ["offset"] Data_encoding.int32) + +let fold_left_kont_encoding enc_a enc_acc = + conv + (fun (origin, acc, offset) -> {origin; acc; offset}) + (fun {origin; acc; offset} -> (origin, acc, offset)) + @@ tup3 + ~flatten:true + (scope ["origin"] enc_a) + (scope ["acc"] enc_acc) + (value ["offset"] Data_encoding.int32) diff --git a/src/lib_scoru_wasm/test/ast_generators.ml b/src/lib_scoru_wasm/test/ast_generators.ml index f7b7c3be3b5dcde4ad99c4614f805678b2fb07f8..767a53e3f87683a27c3d7396a05b61bd35996b32 100644 --- a/src/lib_scoru_wasm/test/ast_generators.ml +++ b/src/lib_scoru_wasm/test/ast_generators.ml @@ -26,6 +26,9 @@ open Tezos_webassembly_interpreter open Lazy_containers open QCheck2.Gen +module Vector = Lazy_containers.Lazy_vector.Int32Vector + +let small_vector_gen gen = Vector.of_list <$> small_list gen let no_region it = Source.{it; at = no_region} @@ -296,7 +299,7 @@ let block_label_gen = let+ n = int32 in Ast.Block_label n -let func_gen = +let ast_func_gen = let* ftype = var_gen in let* locals = vector_gen value_type_gen in let* body = block_label_gen in @@ -305,7 +308,7 @@ let func_gen = let func_gen current_module = let ast_func () = let* func_type = func_type_gen in - let* func = func_gen in + let* func = ast_func_gen in return @@ Func.AstFunc (func_type, current_module, func) in oneof @@ -510,10 +513,10 @@ let module_gen ?module_reg () = let frame_gen ~module_reg = let* inst, _ = module_key_and_instance_gen ~module_reg () in - let+ locals = small_list (map ref value_gen) in + let+ locals = small_vector_gen (map ref value_gen) in Eval.{inst; locals} -let rec admin_instr'_gen ~module_reg depth = +let rec admin_instr'_gen ~module_reg = let open Eval in let from_block_gen = let* block = block_label_gen in @@ -538,46 +541,27 @@ let rec admin_instr'_gen ~module_reg depth = Trapping msg in let returning_gen = - let+ values = small_list value_gen in + let+ values = small_vector_gen value_gen in Returning values in let breaking_gen = let* index = int32 in - let+ values = small_list value_gen in + let+ values = small_vector_gen value_gen in Breaking (index, values) in - let label_gen = - let* index = int32 in - let* final_instrs = small_list instr_gen in - let* values = small_list value_gen in - let+ instrs = small_list (admin_instr_gen ~module_reg (depth - 1)) in - Label (index, final_instrs, (values, instrs)) - in - let frame_gen' = - let* index = int32 in - let* frame = frame_gen ~module_reg in - let* values = small_list value_gen in - let+ instrs = small_list (admin_instr_gen ~module_reg (depth - 1)) in - Frame (index, frame, (values, instrs)) - in oneof - ([ - from_block_gen; - plain_gen; - refer_gen; - invoke_gen; - trapping_gen; - returning_gen; - breaking_gen; - ] - @ if depth > 0 then [label_gen; frame_gen'] else []) - -and admin_instr_gen ~module_reg depth = - map Source.(at no_region) (admin_instr'_gen ~module_reg depth) - -let admin_instr_gen ~module_reg = - let gen = admin_instr_gen ~module_reg in - sized_size (int_bound 3) gen + [ + from_block_gen; + plain_gen; + refer_gen; + invoke_gen; + trapping_gen; + returning_gen; + breaking_gen; + ] + +and admin_instr_gen ~module_reg = + map Source.(at no_region) (admin_instr'_gen ~module_reg) let input_buffer_gen = let gen_message = @@ -614,15 +598,202 @@ let output_buffer_gen = in return Output_buffer.Level_Vector.(of_immutable @@ Vector.of_list s) +let label_gen ~module_reg = + let* label_arity = option (Int32.of_int <$> small_nat) in + let* label_frame_specs = frame_gen ~module_reg in + let* label_break = option instr_gen in + let* es = small_vector_gen (admin_instr_gen ~module_reg) in + let+ vs = small_vector_gen value_gen in + Eval.{label_arity; label_frame_specs; label_break; label_code = (vs, es)} + +let label_stack_gen ~module_reg = + let* label = label_gen ~module_reg in + let+ stack = small_vector_gen (label_gen ~module_reg) in + Eval.Label_stack (label, stack) + +let label_result_gen = + let+ values = small_vector_gen value_gen in + Eval.Label_result values + +let label_trapped_gen = + let+ msg = small_string ~gen:char in + Eval.Label_trapped (no_region @@ msg) + +type packed_label_kont = Packed_lk : 'a Eval.label_kont -> packed_label_kont + +type packed_frame_stack = + | Packed_fs : 'a Eval.frame_stack -> packed_frame_stack + +let packed_label_kont_gen ~module_reg = + let pack x = Packed_lk x in + oneof + [ + pack <$> label_stack_gen ~module_reg; + pack <$> label_result_gen; + pack <$> label_trapped_gen; + ] + +let ongoing_frame_stack_gen ~module_reg = + let* frame_arity = option (Int32.of_int <$> small_nat) in + let* frame_specs = frame_gen ~module_reg in + let+ frame_label_kont = label_stack_gen ~module_reg in + Eval.{frame_arity; frame_specs; frame_label_kont} + +let packed_frame_stack_gen ~module_reg = + let* frame_arity = option (Int32.of_int <$> small_nat) in + let* frame_specs = frame_gen ~module_reg in + let+ (Packed_lk frame_label_kont) = packed_label_kont_gen ~module_reg in + Packed_fs {frame_arity; frame_specs; frame_label_kont} + +let map_kont_gen gen gen' = + let* origin = small_vector_gen gen in + let* destination = small_vector_gen gen' in + let+ offset = Int32.of_int <$> small_nat in + Eval.{origin; destination; offset} + +let concat_kont_gen gen = + let* lv = small_vector_gen gen in + let* rv = small_vector_gen gen in + let* res = small_vector_gen gen in + let+ offset = Int32.of_int <$> small_nat in + Eval.{lv; rv; res; offset} + +let inv_start_gen ~module_reg = + let* module_name = string_printable in + let module_key = Instance.Module_key module_name in + let* func = func_gen module_key in + let* es = small_vector_gen (admin_instr_gen ~module_reg) in + let+ vs = small_vector_gen value_gen in + Eval.Inv_start {func; code = (vs, es)} + +let inv_prepare_locals_gen ~module_reg = + let* arity = Int32.of_int <$> small_nat in + let* args = small_vector_gen value_gen in + let* vs = small_vector_gen value_gen in + let* instructions = small_vector_gen (admin_instr_gen ~module_reg) in + let* module_name = string_printable in + let inst = Instance.Module_key module_name in + let* func = ast_func_gen in + let+ locals_kont = map_kont_gen value_type_gen (ref <$> value_gen) in + Eval.Inv_prepare_locals + {arity; args; vs; instructions; inst; func; locals_kont} + +let inv_prepare_args_gen ~module_reg = + let* arity = Int32.of_int <$> small_nat in + let* vs = small_vector_gen value_gen in + let* instructions = small_vector_gen (admin_instr_gen ~module_reg) in + let* module_name = string_printable in + let inst = Instance.Module_key module_name in + let* func = ast_func_gen in + let* locals = small_vector_gen (ref <$> value_gen) in + let+ args_kont = map_kont_gen value_gen (ref <$> value_gen) in + Eval.Inv_prepare_args {arity; vs; instructions; inst; func; locals; args_kont} + +let inv_concat_gen ~module_reg = + let* arity = Int32.of_int <$> small_nat in + let* vs = small_vector_gen value_gen in + let* instructions = small_vector_gen (admin_instr_gen ~module_reg) in + let* module_name = string_printable in + let inst = Instance.Module_key module_name in + let* func = ast_func_gen in + let+ concat_kont = concat_kont_gen (ref <$> value_gen) in + Eval.Inv_concat {arity; vs; instructions; inst; func; concat_kont} + +let inv_stop_gen ~module_reg = + let* vs = small_vector_gen value_gen in + let* es = small_vector_gen (admin_instr_gen ~module_reg) in + let+ fresh_frame = option (ongoing_frame_stack_gen ~module_reg) in + Eval.Inv_stop {code = (vs, es); fresh_frame} + +let invoke_step_gen ~module_reg = + oneof + [ + inv_start_gen ~module_reg; + inv_prepare_locals_gen ~module_reg; + inv_prepare_args_gen ~module_reg; + inv_concat_gen ~module_reg; + inv_stop_gen ~module_reg; + ] + +let ls_start_gen ~module_reg = + let+ label = label_stack_gen ~module_reg in + Eval.LS_Start label + +let ls_craft_frame_gen ~module_reg = + let* kont = label_stack_gen ~module_reg in + let+ invoke_step = invoke_step_gen ~module_reg in + Eval.LS_Craft_frame (kont, invoke_step) + +let ls_push_frame_gen ~module_reg = + let* kont = label_stack_gen ~module_reg in + let+ frame = ongoing_frame_stack_gen ~module_reg in + Eval.LS_Push_frame (kont, frame) + +let ls_consolidate_top_gen ~module_reg = + let* label = label_gen ~module_reg in + let* kont = concat_kont_gen value_gen in + let* es = small_vector_gen (admin_instr_gen ~module_reg) in + let+ stack = small_vector_gen (label_gen ~module_reg) in + Eval.LS_Consolidate_top (label, kont, es, stack) + +let ls_modify_top_gen ~module_reg = + let+ (Packed_lk kont) = packed_label_kont_gen ~module_reg in + Eval.LS_Modify_top kont + +let label_step_kont_gen ~module_reg = + oneof + [ + ls_start_gen ~module_reg; + ls_craft_frame_gen ~module_reg; + ls_push_frame_gen ~module_reg; + ls_consolidate_top_gen ~module_reg; + ls_modify_top_gen ~module_reg; + ] + +let sk_start_gen ~module_reg = + let* (Packed_fs top) = packed_frame_stack_gen ~module_reg in + let+ stack = small_vector_gen (ongoing_frame_stack_gen ~module_reg) in + Eval.SK_Start (top, stack) + +let sk_next_gen ~module_reg = + let* (Packed_fs top) = packed_frame_stack_gen ~module_reg in + let* stack = small_vector_gen (ongoing_frame_stack_gen ~module_reg) in + let+ label_kont = label_step_kont_gen ~module_reg in + Eval.SK_Next (top, stack, label_kont) + +let sk_consolidate_label_result_gen ~module_reg = + let* frame = ongoing_frame_stack_gen ~module_reg in + let* stack = small_vector_gen (ongoing_frame_stack_gen ~module_reg) in + let* label = label_gen ~module_reg in + let* kont = concat_kont_gen value_gen in + let* es = small_vector_gen (admin_instr_gen ~module_reg) in + let+ lstack = small_vector_gen (label_gen ~module_reg) in + Eval.SK_Consolidate_label_result (frame, stack, label, kont, es, lstack) + +let sk_result_gen = + let+ values = small_vector_gen value_gen in + Eval.SK_Result values + +let sk_trapped_gen = + let+ msg = small_string ~gen:char in + Eval.SK_Trapped (no_region @@ msg) + +let step_kont_gen ~module_reg = + oneof + [ + sk_start_gen ~module_reg; + sk_next_gen ~module_reg; + sk_result_gen; + sk_trapped_gen; + ] + let config_gen ~host_funcs ~module_reg = - let* frame = frame_gen ~module_reg in let* input = input_buffer_gen in let _input_list = Lwt_main.run @@ Lazy_vector.ZVector.to_list @@ Lazy_vector.Mutable.ZVector.snapshot input.content in let* output = output_buffer_gen in - let* instrs = small_list (admin_instr_gen ~module_reg) in - let* values = small_list value_gen in - let+ budget = small_int in - Eval.{frame; input; output; code = (values, instrs); host_funcs; budget} + let* stack_size_limit = small_int in + let+ step_kont = step_kont_gen ~module_reg in + Eval.{input; output; step_kont; host_funcs; stack_size_limit} diff --git a/src/lib_scoru_wasm/test/ast_printer.ml b/src/lib_scoru_wasm/test/ast_printer.ml index e32ba1cfed1ec5c7e1311c3ff75be73308e47da7..ea70d7aac27664d8f9e7704ab09c4be0215c4089 100644 --- a/src/lib_scoru_wasm/test/ast_printer.ml +++ b/src/lib_scoru_wasm/test/ast_printer.ml @@ -240,12 +240,15 @@ let pp_module out let pp_frame out frame = let open Eval in let (Module_key key) = frame.inst in + let locals = + Lwt_main.run (Lazy_containers.Lazy_vector.Int32Vector.to_list frame.locals) + in Format.fprintf out "@[{module = %s;@;locals = %a;@;}@]" key - (Format.pp_print_list Values.pp_value) - (List.map ( ! ) frame.locals) + (pp_vector Values.pp_value) + (Lazy_containers.Lazy_vector.Int32Vector.of_list (List.map ( ! ) locals)) let rec pp_admin_instr' out instr = let open Eval in @@ -267,39 +270,256 @@ let rec pp_admin_instr' out instr = Format.fprintf out "Returning @[%a@]" - (Format.pp_print_list Values.pp_value) + (pp_vector Values.pp_value) values | Breaking (index, values) -> Format.fprintf out "Breaking @[(%li,@; %a)@]" index - (Format.pp_print_list Values.pp_value) + (pp_vector Values.pp_value) values - | Label (index, final_instrs, (values, instrs)) -> + +and pp_admin_instr out instr = pp_admin_instr' out instr.Source.it + +let pp_label out + Eval.{label_arity; label_frame_specs; label_break; label_code = vs, es} = + Format.fprintf + out + "@[{label_arity = %a;@;\ + label_frame_specs = %a;@;\ + label_break = %a;@;\ + instructions = %a; values = %a}@]" + (pp_opt (fun out x -> Format.fprintf out "%ld" x)) + label_arity + pp_frame + label_frame_specs + (pp_opt Ast.pp_instr) + label_break + (pp_vector pp_admin_instr) + es + (pp_vector Values.pp_value) + vs + +let pp_label_kont : type a. Format.formatter -> a Eval.label_kont -> unit = + fun out -> function + | Label_stack (label, stack) -> Format.fprintf out - "Label @[(%li,@; %a,@; %a,@; %a)@]" - index - (Format.pp_print_list Ast.pp_instr) - final_instrs - (Format.pp_print_list Values.pp_value) - values - (Format.pp_print_list pp_admin_instr) - instrs - | Frame (index, frame, (values, instrs)) -> + "@[Label_stack (@;%a,@;%a@;)@]" + pp_label + label + (pp_vector pp_label) + stack + | Label_result res -> Format.fprintf out - "Frame @[(%li,@; %a,@; %a,@; %a)@]" - index - pp_frame - frame - (Format.pp_print_list Values.pp_value) - values - (Format.pp_print_list pp_admin_instr) - instrs + "@[Label_result %a@]" + (pp_vector Values.pp_value) + res + | Label_trapped msg -> Format.fprintf out "@[Label_trapped %s@]" msg.it -and pp_admin_instr out instr = pp_admin_instr' out instr.Source.it +let pp_frame_stack out Eval.{frame_arity; frame_specs; frame_label_kont} = + Format.fprintf + out + "@[{frame_arity = %a;@;frame_specs = %a;@;frame_label_kont = %a}@]" + (pp_opt (fun out x -> Format.fprintf out "%ld" x)) + frame_arity + pp_frame + frame_specs + pp_label_kont + frame_label_kont + +let pp_map_kont pp_origin pp_destination out Eval.{origin; destination; offset} + = + Format.fprintf + out + "@[{origin = %a;@;destination = %a;@;offset = %ld}@]" + (pp_vector pp_origin) + origin + (pp_vector pp_destination) + destination + offset + +let pp_concat_kont pp out Eval.{lv; rv; res; offset} = + Format.fprintf + out + "@[{lv = %a;@;rv = %a;@;res = %a;@;offset = %ld;@;}@]" + (pp_vector pp) + lv + (pp_vector pp) + rv + (pp_vector pp) + res + offset + +let pp_invoke_step_kont out = function + | Eval.Inv_start {func; code = vs, es} -> + Format.fprintf + out + "@[Inv_start {func = %a;@;instructions = %a;@;values = %a}@]" + Instance.pp_func_inst + func + (pp_vector pp_admin_instr) + es + (pp_vector Values.pp_value) + vs + | Inv_prepare_locals + {arity; args; vs; instructions; inst = Module_key inst; func; locals_kont} + -> + Format.fprintf + out + "@[Inv_prepare_locals {arity = %ld;@;\ + args = %a;@;\ + values = %a;@;\ + instructions = %a;@;\ + inst = %s;@;\ + func = %a;@;\ + locals_kont = %a;@;\ + }" + arity + (pp_vector Values.pp_value) + args + (pp_vector Values.pp_value) + vs + (pp_vector pp_admin_instr) + instructions + inst + Ast.pp_func + func + (pp_map_kont Types.pp_value_type (fun out x -> Values.pp_value out !x)) + locals_kont + | Inv_prepare_args + {arity; vs; instructions; inst = Module_key inst; func; locals; args_kont} + -> + Format.fprintf + out + "@[Inv_prepare_locals {arity = %ld;@;\ + values = %a;@;\ + instructions = %a;@;\ + inst = %s;@;\ + func = %a;@;\ + locals = %a;@;\ + args_kont = %a;@;\ + }" + arity + (pp_vector Values.pp_value) + vs + (pp_vector pp_admin_instr) + instructions + inst + Ast.pp_func + func + (pp_vector (fun out x -> Values.pp_value out !x)) + locals + (pp_map_kont Values.pp_value (fun out x -> Values.pp_value out !x)) + args_kont + | Inv_concat + {arity; vs; instructions; inst = Module_key inst; func; concat_kont} -> + Format.fprintf + out + "@[Inv_prepare_locals {arity = %ld;@;\ + values = %a;@;\ + instructions = %a;@;\ + inst = %s;@;\ + func = %a;@;\ + concat_kont = %a;@;\ + }" + arity + (pp_vector Values.pp_value) + vs + (pp_vector pp_admin_instr) + instructions + inst + Ast.pp_func + func + (pp_concat_kont (fun out x -> Values.pp_value out !x)) + concat_kont + | Inv_stop {code = vs, es; fresh_frame} -> + Format.fprintf + out + "%@[Inv_stop {values = %a;@;\ + instructions = %a;@;\ + fresh_frame = %a}@]" + (pp_vector Values.pp_value) + vs + (pp_vector pp_admin_instr) + es + (pp_opt pp_frame_stack) + fresh_frame + +let pp_label_step_kont out = function + | Eval.LS_Start label_kont -> + Format.fprintf out "@[LS_Start %a@]" pp_label_kont label_kont + | LS_Craft_frame (label_kont, kont) -> + Format.fprintf + out + "@[LS_Craft_frame (%a, %a)@]" + pp_label_kont + label_kont + pp_invoke_step_kont + kont + | LS_Push_frame (label_kont, frame) -> + Format.fprintf + out + "@[LS_Push_frame (%a, %a)@]" + pp_label_kont + label_kont + pp_frame_stack + frame + | LS_Consolidate_top (label, kont, es, labels) -> + Format.fprintf + out + "@[LS_Consolidate_top (%a, %a, %a, %a)@]" + pp_label + label + (pp_concat_kont Values.pp_value) + kont + (pp_vector pp_admin_instr) + es + (pp_vector pp_label) + labels + | LS_Modify_top label_kont -> + Format.fprintf out "@[LS_Modify_top %a@]" pp_label_kont label_kont + +let pp_step_kont out = function + | Eval.SK_Start (frame, stack) -> + Format.fprintf + out + "@[SK_Start (%a; %a)@]" + pp_frame_stack + frame + (pp_vector pp_frame_stack) + stack + | SK_Next (frame_stack, stack, kont) -> + Format.fprintf + out + "@[SK_Next (%a, %a, %a)@]" + pp_frame_stack + frame_stack + (pp_vector pp_frame_stack) + stack + pp_label_step_kont + kont + | SK_Consolidate_label_result (frame, stack, label, kont, es, labels) -> + Format.fprintf + out + "@[SK_Consolidate_label_result (%a, %a, %a, %a, %a, %a)@]" + pp_frame_stack + frame + (pp_vector pp_frame_stack) + stack + pp_label + label + (pp_concat_kont Values.pp_value) + kont + (pp_vector pp_admin_instr) + es + (pp_vector pp_label) + labels + | SK_Result vs -> + Format.fprintf out "@[SK_Result %a@]" (pp_vector Values.pp_value) vs + | SK_Trapped msg -> Format.fprintf out "@[SK_Trapped %s@]" msg.it let pp_input_buffer out input = let open Input_buffer in @@ -325,24 +545,14 @@ let pp_output_buffer out (output : Output_buffer.t) = (Output_buffer.Level_Vector.snapshot output) let pp_config out - Eval.{frame; input; output; code = values, instrs; host_funcs = _; budget} = + Eval.{input; output; step_kont; host_funcs = _; stack_size_limit} = Format.fprintf out - "@[{frame = %a;@;\ - input = %a;@;\ - output = %a;@;\ - instructions = %a;@;\ - values = %a;@;\ - budget = %i;@;\ - }@]" - pp_frame - frame + "@[{input = %a;@;output = %a;@;frame_kont = %a;@;budget = %i;@;}@]" pp_input_buffer input pp_output_buffer output - (Format.pp_print_list pp_admin_instr) - instrs - (Format.pp_print_list Values.pp_value) - values - budget + pp_step_kont + step_kont + stack_size_limit diff --git a/src/lib_scoru_wasm/test/test_get_set.ml b/src/lib_scoru_wasm/test/test_get_set.ml index 05fb8d0f0058824c2b766afded34fcabb5519dcb..d977241b55477e83531ae3f7d1e1f27410826e28 100644 --- a/src/lib_scoru_wasm/test/test_get_set.ml +++ b/src/lib_scoru_wasm/test/test_get_set.ml @@ -37,6 +37,7 @@ open Tezos_scoru_wasm (* Use context-binary for testing. *) module Context = Tezos_context_memory.Context_binary +module Vector = Lazy_containers.Lazy_vector.Int32Vector let empty_tree () = let open Lwt_syntax in @@ -222,15 +223,13 @@ let test_set_input () = in let host_funcs = Tezos_webassembly_interpreter.Host_funcs.empty () in let tick_state = - let open Instance in Eval. { - frame = {inst = Module_key "main"; locals = []}; input = Input_buffer.alloc (); output = Output_buffer.alloc (); - code = ([], []); host_funcs; - budget = 1000; + step_kont = SK_Result (Vector.empty ()); + stack_size_limit = 1000; } in let* tree = encode_tick_state ~host_funcs tick_state tree in @@ -263,8 +262,8 @@ let test_set_input () = assert (result_input = "hello") ; Lwt_result_syntax.return_unit -(** Given a [config] whose output has a given payload at position (0,0), if we -encode [config] into a tree [get_output output_info tree] produces the same +(** Given a [config] whose output has a given payload at position (0,0), if we +encode [config] into a tree [get_output output_info tree] produces the same payload. Here the output_info is { outbox_level = 0; message_index = 0 } *) let test_get_output () = let open Lwt_syntax in @@ -276,15 +275,13 @@ let test_get_output () = Output_buffer.set_level output 0l ; let* () = Output_buffer.set_value output @@ Bytes.of_string "hello" in let tick_state = - let open Instance in Eval. { - frame = {inst = Module_key "main"; locals = []}; input = Input_buffer.alloc (); output; - code = ([], []); host_funcs; - budget = 1000; + step_kont = SK_Result (Vector.empty ()); + stack_size_limit = 1000; } in let* tree = encode_tick_state ~host_funcs tick_state tree in diff --git a/src/lib_scoru_wasm/test/test_parser_encoding.ml b/src/lib_scoru_wasm/test/test_parser_encoding.ml index cd98cdde441aa654a3e57e6cc5a298aaae221b9e..4694cccf8d4157e8014dba99e623578c5de05f95 100644 --- a/src/lib_scoru_wasm/test/test_parser_encoding.ml +++ b/src/lib_scoru_wasm/test/test_parser_encoding.ml @@ -1082,8 +1082,12 @@ module Module = struct let* func_types = Vec.gen Ast_generators.var_gen in let* func_bodies = Field.code_field_gen in let* func_kont = LazyVec.gen Code.func_gen in + let* iterators = + option (LazyVec.gen (LazyVec.gen Ast_generators.instr_gen)) + in let+ datas_in_func = bool in - Decode.MKElaborateFunc (func_types, func_bodies, func_kont, datas_in_func) + Decode.MKElaborateFunc + (func_types, func_bodies, func_kont, iterators, datas_in_func) in let build = let* funcs = opt (Vec.gen Code.func_gen) in @@ -1240,6 +1244,14 @@ module Module = struct let check_without_region check x y = check x.Source.it y.Source.it + let check_option f x y = + match (x, y) with + | Some x, Some y -> f x y + | None, None -> Lwt_result.return true + | _, _ -> Lwt_result.return false + + let eq_instr i i' = Lwt_result.return (i = i') + let check mk mk' = let open Lwt_result_syntax in match (mk, mk') with @@ -1258,17 +1270,23 @@ module Module = struct in let+ eq_size = Size.check size size' in eq_kont && eq_size && Field.check_field_type ft ft' - | ( MKElaborateFunc (fts, fbs, kont, datas), - MKElaborateFunc (fts', fbs', kont', datas') ) -> + | ( MKElaborateFunc (fts, fbs, kont, iterators, datas), + MKElaborateFunc (fts', fbs', kont', iterators', datas') ) -> let eq_vars v v' = return (v = v') in let* eq_fts = Vec.check eq_vars fts fts' in let* eq_fbs = Vec.check (check_without_region Code.check_func) fbs fbs' in + let* eq_its = + check_option + (LazyVec.check (LazyVec.check eq_instr)) + iterators + iterators' + in let+ eq_kont = LazyVec.check (check_without_region Code.check_func) kont kont' in - eq_fts && eq_fbs && eq_kont && datas = datas' + eq_fts && eq_fbs && eq_kont && eq_its && datas = datas' | MKBuild (Some funcs, datas), MKBuild (Some funcs', datas') -> let+ eq_funcs = Vec.check (check_without_region Code.check_func) funcs funcs' diff --git a/src/lib_scoru_wasm/test/test_wasm_encoding.ml b/src/lib_scoru_wasm/test/test_wasm_encoding.ml index 5641336cf9b8f7697aabdc9c95db8f4e7fd15733..07f090e28d1156d2850a793fe2189d0834e43a3b 100644 --- a/src/lib_scoru_wasm/test/test_wasm_encoding.ml +++ b/src/lib_scoru_wasm/test/test_wasm_encoding.ml @@ -138,9 +138,12 @@ let test_output_buffer_tree = (** Test serialize/deserialize values and compare trees. *) let test_values_tree = test_generic_tree - ~pp:(Format.pp_print_list Ast_printer.Values.pp_value) + ~pp:(Ast_printer.pp_vector Ast_printer.Values.pp_value) ~gen:(fun ~host_funcs:_ ~module_reg:_ -> - QCheck2.Gen.list Ast_generators.value_gen) + QCheck2.Gen.( + map + Lazy_containers.Lazy_vector.Int32Vector.of_list + (list Ast_generators.value_gen))) ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.values_encoding) (** Test serialize/deserialize administrative instructions and compare trees. *) diff --git a/src/lib_scoru_wasm/wasm_encoding.ml b/src/lib_scoru_wasm/wasm_encoding.ml index 119a3617157a2b669c74bf2bbf468041664b2340..5325c5197f1a63058499f6770d5af6b363dd9643 100644 --- a/src/lib_scoru_wasm/wasm_encoding.ml +++ b/src/lib_scoru_wasm/wasm_encoding.ml @@ -25,6 +25,7 @@ open Tezos_webassembly_interpreter open Lazy_containers +open Kont_encodings exception Uninitialized_current_module @@ -38,19 +39,28 @@ module ModuleMap = Lazy_map_encoding.Make (Instance.ModuleMap.Map) (** Utility function*) let string_tag = value [] Data_encoding.string -let list_encoding item_enc = - let vector = int32_lazy_vector (value [] Data_encoding.int32) item_enc in - (* TODO: https://gitlab.com/tezos/tezos/-/issues/3076 - This should return a [Instance.Vector.t] instead of a list. Once the AST - has been sufficiently adapted to lazy vectors and maps, this change can - go forward. *) - conv_lwt V.to_list (fun list -> Lwt.return (V.of_list list)) vector - let lazy_vector_encoding field_name tree_encoding = scope [field_name] (int32_lazy_vector (value [] Data_encoding.int32) tree_encoding) +let lazy_vector_encoding' tree_encoding = + int32_lazy_vector (value [] Data_encoding.int32) tree_encoding + +let func_encoding = + let ftype = value ["ftype"] Interpreter_encodings.Ast.var_encoding in + let locals = + lazy_vector_encoding + "locals" + (value [] Interpreter_encodings.Types.value_type_encoding) + in + let body = value ["body"] Interpreter_encodings.Ast.block_label_encoding in + conv + (fun (ftype, locals, body) -> + Source.(Ast.{ftype; locals; body} @@ no_region)) + (fun {it = {ftype; locals; body}; _} -> (ftype, locals, body)) + (tup3 ~flatten:true ftype locals body) + let function_type_encoding = conv (fun (params, result) -> Types.FuncType (params, result)) @@ -65,7 +75,7 @@ let function_type_encoding = (value [] Interpreter_encodings.Types.value_type_encoding))) let var_list_encoding = - list_encoding (value [] Interpreter_encodings.Ast.var_encoding) + value [] (Data_encoding.list Interpreter_encodings.Ast.var_encoding) let block_label_encoding = value [] Interpreter_encodings.Ast.block_label_encoding @@ -533,7 +543,7 @@ let value_encoding = (fun r -> Values.Ref r); ] -let values_encoding = list_encoding value_encoding +let values_encoding = lazy_vector_encoding' value_encoding let name_encoding key = lazy_vector_encoding key (value [] Data_encoding.int31) @@ -710,14 +720,13 @@ let module_instances_encoding = (scope ["modules"] (ModuleMap.lazy_map module_instance_encoding)) let frame_encoding = - let locals_encoding = list_encoding @@ conv ref ( ! ) @@ value_encoding in conv (fun (inst, locals) -> Eval.{inst; locals}) (fun Eval.{inst; locals} -> (inst, locals)) (tup2 ~flatten:true (scope ["module"] module_key_encoding) - (scope ["locals"] locals_encoding)) + (lazy_vector_encoding "locals" (conv ref ( ! ) @@ value_encoding))) let rec admin_instr'_encoding () = let open Eval in @@ -764,34 +773,6 @@ let rec admin_instr'_encoding () = (function | Breaking (index, values) -> Some (index, values) | _ -> None) (fun (index, values) -> Breaking (index, values)); - case - "Label" - (tup4 - ~flatten:false - (value [] Data_encoding.int32) - (list_encoding instruction_encoding) - values_encoding - (list_encoding (admin_instr_encoding ()))) - (function - | Label (index, final_instrs, (values, instrs)) -> - Some (index, final_instrs, values, instrs) - | _ -> None) - (fun (index, final_instrs, values, instrs) -> - Label (index, final_instrs, (values, instrs))); - case - "Frame" - (tup4 - ~flatten:false - (value [] Data_encoding.int32) - frame_encoding - values_encoding - (list_encoding (admin_instr_encoding ()))) - (function - | Frame (index, frame, (values, instrs)) -> - Some (index, frame, values, instrs) - | _ -> None) - (fun (index, frame, values, instrs) -> - Frame (index, frame, (values, instrs))); ] and admin_instr_encoding () = @@ -838,6 +819,287 @@ let input_buffer_encoding = input_buffer_message_encoding)) (value ["num-messages"] Data_encoding.z)) +let label_encoding = + conv + (fun (label_arity, label_frame_specs, label_break, vs, es) -> + Eval.{label_arity; label_frame_specs; label_break; label_code = (vs, es)}) + (fun {label_arity; label_frame_specs; label_break; label_code = vs, es} -> + (label_arity, label_frame_specs, label_break, vs, es)) + (tup5 + ~flatten:true + (value_option ["arity"] Data_encoding.int32) + (scope ["frame"] frame_encoding) + (scope ["label_break"] (option instruction_encoding)) + (scope ["values"] values_encoding) + (lazy_vector_encoding "instructions" admin_instr_encoding)) + +let ongoing_label_kont_encoding : Eval.ongoing Eval.label_kont t = + tagged_union + string_tag + [ + case + "Label_stack" + (tup2 + ~flatten:true + (scope ["top"] label_encoding) + (lazy_vector_encoding "rst" label_encoding)) + (function Eval.Label_stack (label, stack) -> Some (label, stack)) + (fun (label, stack) -> Label_stack (label, stack)); + ] + +type packed_label_kont = Packed : 'a Eval.label_kont -> packed_label_kont + +let packed_label_kont_encoding : packed_label_kont t = + tagged_union + string_tag + [ + case + "Label_stack" + (tup2 + ~flatten:true + (scope ["top"] label_encoding) + (lazy_vector_encoding "rst" label_encoding)) + (function + | Packed (Label_stack (label, stack)) -> Some (label, stack) + | _ -> None) + (fun (label, stack) -> Packed (Label_stack (label, stack))); + case + "Label_result" + values_encoding + (function Packed (Label_result vs0) -> Some vs0 | _ -> None) + (fun vs0 -> Packed (Label_result vs0)); + case + "Label_trapped" + (value [] Data_encoding.string) + (function Packed (Label_trapped msg) -> Some msg.it | _ -> None) + (fun msg -> Packed (Label_trapped Source.(msg @@ no_region))); + ] + +let ongoing_frame_stack_encoding = + conv + (fun (frame_arity, frame_specs, frame_label_kont) -> + Eval.{frame_arity; frame_specs; frame_label_kont}) + (fun {frame_arity; frame_specs; frame_label_kont} -> + (frame_arity, frame_specs, frame_label_kont)) + (tup3 + ~flatten:true + (value_option ["arity"] Data_encoding.int32) + (scope ["frame"] frame_encoding) + (scope ["label_kont"] ongoing_label_kont_encoding)) + +type packed_frame_stack = + | Packed_fs : 'a Eval.frame_stack -> packed_frame_stack + +let packed_frame_stack_encoding = + conv + (fun (frame_arity, frame_specs, Packed frame_label_kont) -> + Packed_fs Eval.{frame_arity; frame_specs; frame_label_kont}) + (function + | Packed_fs Eval.{frame_arity; frame_specs; frame_label_kont} -> + (frame_arity, frame_specs, Packed frame_label_kont)) + (tup3 + ~flatten:true + (value_option ["arity"] Data_encoding.int32) + (scope ["frame"] frame_encoding) + (scope ["label_kont"] packed_label_kont_encoding)) + +let invoke_step_kont_encoding = + tagged_union + string_tag + [ + case + "Inv_start" + (tup3 + ~flatten:true + (scope ["func"] function_encoding) + (scope ["values"] values_encoding) + (lazy_vector_encoding "instructions" admin_instr_encoding)) + (function + | Eval.Inv_start {func; code = vs, es} -> Some (func, vs, es) + | _ -> None) + (fun (func, vs, es) -> Inv_start {func; code = (vs, es)}); + case + "Inv_prepare_locals" + (tup7 + ~flatten:true + (value ["arity"] Data_encoding.int32) + (lazy_vector_encoding "args" value_encoding) + (lazy_vector_encoding "values" value_encoding) + (lazy_vector_encoding "instructions" admin_instr_encoding) + (scope ["inst"] module_key_encoding) + (scope ["func"] func_encoding) + (scope + ["kont"] + (map_kont_encoding + (lazy_vector_encoding + "x" + (value [] Interpreter_encodings.Types.value_type_encoding)) + (lazy_vector_encoding "y" (conv ref ( ! ) @@ value_encoding))))) + (function + | Eval.Inv_prepare_locals + {arity; args; vs; instructions; inst; func; locals_kont} -> + Some (arity, args, vs, instructions, inst, func, locals_kont) + | _ -> None) + (fun (arity, args, vs, instructions, inst, func, locals_kont) -> + Inv_prepare_locals + {arity; args; vs; instructions; inst; func; locals_kont}); + case + "Inv_prepare_args" + (tup7 + ~flatten:true + (value ["arity"] Data_encoding.int32) + (lazy_vector_encoding "values" value_encoding) + (lazy_vector_encoding "instructions" admin_instr_encoding) + (scope ["inst"] module_key_encoding) + (scope ["func"] func_encoding) + (lazy_vector_encoding "locals" (conv ref ( ! ) @@ value_encoding)) + (scope + ["kont"] + (map_kont_encoding + (lazy_vector_encoding "1" value_encoding) + (lazy_vector_encoding "2" (conv ref ( ! ) @@ value_encoding))))) + (function + | Eval.Inv_prepare_args + {arity; vs; instructions; inst; func; locals; args_kont} -> + Some (arity, vs, instructions, inst, func, locals, args_kont) + | _ -> None) + (fun (arity, vs, instructions, inst, func, locals, args_kont) -> + Inv_prepare_args + {arity; vs; instructions; inst; func; locals; args_kont}); + case + "Inv_concat" + (tup6 + ~flatten:true + (value ["arity"] Data_encoding.int32) + (lazy_vector_encoding "values" value_encoding) + (lazy_vector_encoding "instructions" admin_instr_encoding) + (scope ["inst"] module_key_encoding) + (scope ["func"] func_encoding) + (scope + ["kont"] + (concat_kont_encoding + (lazy_vector_encoding "2" (conv ref ( ! ) @@ value_encoding))))) + (function + | Eval.Inv_concat {arity; vs; instructions; inst; func; concat_kont} + -> + Some (arity, vs, instructions, inst, func, concat_kont) + | _ -> None) + (fun (arity, vs, instructions, inst, func, concat_kont) -> + Inv_concat {arity; vs; instructions; inst; func; concat_kont}); + case + "Inv_stop" + (tup3 + ~flatten:true + (scope ["values"] values_encoding) + (lazy_vector_encoding "instructions" admin_instr_encoding) + (scope ["fresh_frame"] (option ongoing_frame_stack_encoding))) + (function + | Eval.Inv_stop {code = vs, es; fresh_frame} -> + Some (vs, es, fresh_frame) + | _ -> None) + (fun (vs, es, fresh_frame) -> Inv_stop {code = (vs, es); fresh_frame}); + ] + +let label_step_kont_encoding = + tagged_union + string_tag + [ + case + "LS_Start" + ongoing_label_kont_encoding + (function Eval.LS_Start label -> Some label | _ -> None) + (fun label -> LS_Start label); + case + "LS_Craft_frame" + (tup2 + ~flatten:true + (scope ["label_kont"] ongoing_label_kont_encoding) + (scope ["invoke_kont"] invoke_step_kont_encoding)) + (function Eval.LS_Craft_frame (l, i) -> Some (l, i) | _ -> None) + (fun (l, i) -> LS_Craft_frame (l, i)); + case + "LS_Push_frame" + (tup2 + ~flatten:true + (scope ["label_kont"] ongoing_label_kont_encoding) + (scope ["fresh_frame"] ongoing_frame_stack_encoding)) + (function Eval.LS_Push_frame (l, i) -> Some (l, i) | _ -> None) + (fun (l, i) -> LS_Push_frame (l, i)); + case + "LS_Consolidate_top" + (tup4 + ~flatten:true + (scope ["label"] label_encoding) + (scope + ["kont"] + (concat_kont_encoding (lazy_vector_encoding' value_encoding))) + (lazy_vector_encoding "instructions" admin_instr_encoding) + (lazy_vector_encoding "labels-stack" label_encoding)) + (function + | Eval.LS_Consolidate_top (l, k, es, s) -> Some (l, k, es, s) + | _ -> None) + (fun (l, k, es, s) -> LS_Consolidate_top (l, k, es, s)); + case + "LS_Modify_top" + packed_label_kont_encoding + (function Eval.LS_Modify_top l -> Some (Packed l) | _ -> None) + (fun (Packed l) -> LS_Modify_top l); + ] + +let step_kont_encoding = + tagged_union + string_tag + [ + case + "SK_Start" + (tup2 + ~flatten:true + (scope ["top"] packed_frame_stack_encoding) + (lazy_vector_encoding "rst" ongoing_frame_stack_encoding)) + (function + | Eval.SK_Start (f, rst) -> Some (Packed_fs f, rst) | _ -> None) + (fun (Packed_fs f, rst) -> SK_Start (f, rst)); + case + "SK_Next" + (tup3 + ~flatten:true + (scope ["top"] packed_frame_stack_encoding) + (lazy_vector_encoding "rst" ongoing_frame_stack_encoding) + (scope ["kont"] label_step_kont_encoding)) + (function + | Eval.SK_Next (f, r, k) -> Some (Packed_fs f, r, k) | _ -> None) + (fun (Packed_fs f, r, k) -> SK_Next (f, r, k)); + case + "SK_Consolidate_label_result" + (tup6 + ~flatten:true + (scope ["top-frame"] ongoing_frame_stack_encoding) + (lazy_vector_encoding "frames-stack" ongoing_frame_stack_encoding) + (scope ["top-label"] label_encoding) + (scope + ["kont"] + (concat_kont_encoding (lazy_vector_encoding' value_encoding))) + (lazy_vector_encoding "instructions" admin_instr_encoding) + (lazy_vector_encoding "labels-stack" label_encoding)) + (function + | Eval.SK_Consolidate_label_result + (frame', stack, label, vs, es, lstack) -> + Some (frame', stack, label, vs, es, lstack) + | _ -> None) + (fun (frame', stack, label, vs, es, lstack) -> + SK_Consolidate_label_result (frame', stack, label, vs, es, lstack)); + case + "SK_Result" + values_encoding + (function Eval.SK_Result vs -> Some vs | _ -> None) + (fun vs -> SK_Result vs); + case + "SK_Trapped" + (value [] Data_encoding.string) + (function Eval.SK_Trapped msg -> Some msg.it | _ -> None) + (fun msg -> SK_Trapped Source.(msg @@ no_region)); + ] + let index_vector_encoding = conv (fun index -> Output_buffer.Index_Vector.of_immutable index) @@ -852,15 +1114,13 @@ let output_buffer_encoding = let config_encoding ~host_funcs = conv - (fun (frame, input, output, instrs, values, budget) -> - Eval.{frame; input; output; code = (values, instrs); host_funcs; budget}) - (fun Eval.{frame; input; output; code = values, instrs; budget; _} -> - (frame, input, output, instrs, values, budget)) - (tup6 + (fun (input, output, step_kont, stack_size_limit) -> + Eval.{input; output; step_kont; host_funcs; stack_size_limit}) + (fun Eval.{input; output; step_kont; stack_size_limit; _} -> + (input, output, step_kont, stack_size_limit)) + (tup4 ~flatten:true - (scope ["frame"] frame_encoding) (scope ["input"] input_buffer_encoding) (scope ["output"] output_buffer_encoding) - (scope ["instructions"] (list_encoding admin_instr_encoding)) - (scope ["values"] values_encoding) - (value ["budget"] Data_encoding.int31)) + (scope ["step_kont"] step_kont_encoding) + (value ["stack_size_limit"] Data_encoding.int31)) diff --git a/src/lib_scoru_wasm/wasm_encoding.mli b/src/lib_scoru_wasm/wasm_encoding.mli index 8ee4913461d1bf43f01c64d35ae2e467ca893cc5..f4290c8438a78fcb543d6ff3e4fdb4f3c2f1afca 100644 --- a/src/lib_scoru_wasm/wasm_encoding.mli +++ b/src/lib_scoru_wasm/wasm_encoding.mli @@ -31,6 +31,8 @@ val var_list_encoding : Ast.var list Tree_encoding.t val instruction_encoding : Ast.instr Tree_encoding.t +val func_encoding : Ast.func Tree_encoding.t + val module_key_encoding : Instance.module_key Tree_encoding.t val function_encoding : Instance.func_inst Tree_encoding.t @@ -39,7 +41,7 @@ val value_ref_encoding : Values.ref_ Tree_encoding.t val value_encoding : Values.value Tree_encoding.t -val values_encoding : Values.value list Tree_encoding.t +val values_encoding : Values.value Instance.Vector.t Tree_encoding.t val memory_encoding : Partial_memory.memory Tree_encoding.t diff --git a/src/lib_scoru_wasm/wasm_pvm.ml b/src/lib_scoru_wasm/wasm_pvm.ml index 7081da521f7d171ad97370c0b2fba75f530d7fea..1164b0f3a4780babfe5447b908fa723883e2cd36 100644 --- a/src/lib_scoru_wasm/wasm_pvm.ml +++ b/src/lib_scoru_wasm/wasm_pvm.ml @@ -174,9 +174,41 @@ struct | Decode m -> let+ m = Tezos_webassembly_interpreter.Decode.module_step kernel m in Decode m - | Init {self; ast_module = _; init_kont = IK_Stop _module_inst} -> - let eval_config = Wasm.Eval.config host_funcs self [] [] in - Lwt.return (Eval eval_config) + | Init {self; ast_module = _; init_kont = IK_Stop _module_inst} -> ( + let* module_inst = + Wasm.Instance.ModuleMap.get wasm_main_module_name module_reg + in + let* main_name = + Wasm.Instance.Vector.to_list @@ Wasm.Utf8.decode wasm_entrypoint + in + let* extern = + Wasm.Instance.NameMap.get + main_name + module_inst.Wasm.Instance.exports + in + match extern with + | Wasm.Instance.ExternFunc main_func -> + let admin_instr' = Wasm.Eval.Invoke main_func in + let admin_instr = + Wasm.Source.{it = admin_instr'; at = no_region} + in + (* Clear the values and the locals in the frame. *) + let eval_config = + Wasm.Eval.config + host_funcs + self + (Lazy_containers.Lazy_vector.Int32Vector.empty ()) + (Lazy_containers.Lazy_vector.Int32Vector.singleton + admin_instr) + in + Lwt.return (Eval eval_config) + | _ -> + (* We require a function with the name [main] to be exported + rather than any other structure. *) + Lwt.return + (Stuck + (Invalid_state "Invalid_module: no `main` function exported")) + ) | Init {self; ast_module; init_kont} -> let* init_kont = Wasm.Eval.init_step @@ -188,50 +220,9 @@ struct init_kont in Lwt.return (Init {self; ast_module; init_kont}) - | Eval ({Wasm.Eval.frame; code; _} as eval_config) -> ( - match code with - | _values, [] -> ( - (* We have an empty set of admin instructions so we create one - that invokes the main function. *) - let* module_inst = - Wasm.Instance.ModuleMap.get wasm_main_module_name module_reg - in - let* main_name = - Wasm.Instance.Vector.to_list @@ Wasm.Utf8.decode wasm_entrypoint - in - let* extern = - Wasm.Instance.NameMap.get - main_name - module_inst.Wasm.Instance.exports - in - - match extern with - | Wasm.Instance.ExternFunc main_func -> - let admin_instr' = Wasm.Eval.Invoke main_func in - let admin_instr = - Wasm.Source.{it = admin_instr'; at = no_region} - in - (* Clear the values and the locals in the frame. *) - let code = ([], [admin_instr]) in - let eval_config = - { - eval_config with - Wasm.Eval.frame = {frame with locals = []}; - code; - } - in - Lwt.return (Eval eval_config) - | _ -> - (* We require a function with the name [main] to be exported - rather than any other structure. *) - Lwt.return - (Stuck - (Invalid_state - "Invalid_module: no `main` function exported"))) - | _ -> - (* Continue execution. *) - let* eval_config = Wasm.Eval.step module_reg eval_config in - Lwt.return (Eval eval_config)) + | Eval eval_config -> + let+ eval_config = Wasm.Eval.step module_reg eval_config in + Eval eval_config | Stuck e -> Lwt.return (Stuck e) let next_tick_state pvm_state = @@ -255,13 +246,22 @@ struct let* pvm_state = Tree_encoding_runner.decode pvm_state_encoding tree in (* Calculate the next tick state. *) let* tick_state = next_tick_state pvm_state in - let input_request = - match pvm_state.tick_state with - | Eval {code = _, []; _} | Stuck _ -> + let input_request, tick_state = + match tick_state with + | Eval {step_kont = Wasm.Eval.(SK_Result _); _} -> (* Ask for more input if the kernel has yielded (empty admin - instructions). *) - Wasm_pvm_sig.Input_required - | _ -> Wasm_pvm_sig.No_input_required + instructions, or error). *) + (Wasm_pvm_sig.Input_required, tick_state) + | Eval {step_kont = Wasm.Eval.(SK_Trapped msg); _} -> + ( Wasm_pvm_sig.Input_required, + Stuck + (Wasm_pvm_errors.Eval_error + { + raw_exception = "trapped execution"; + explanation = Some msg.it; + }) ) + | Stuck _ -> (Wasm_pvm_sig.Input_required, tick_state) + | _ -> (Wasm_pvm_sig.No_input_required, tick_state) in (* Update the tick state and input-request and increment the current tick *) let pvm_state = @@ -272,6 +272,23 @@ struct current_tick = Z.succ pvm_state.current_tick; } in + + (* {{Note tick state clean-up}} + + The "wasm" directory in the Irmin tree of the PVM is used to + maintain a lot of information across tick, but as of now, it + was never cleaned up. It meant that the tree would become + crowded with data that were no longer needed. + + It turns out it is very simple to clean up, thanks to subtree + move. Because we keep in the lazy-containers the original + subtree, and we inject it prior to updating read keys, the + tree-encoding library does not rely on the input tree at + encoding time. + + With this, we gain an additional 5% of proof size in the + worst tick of the computation.wasm kernel. *) + let* tree = T.remove tree ["wasm"] in Tree_encoding_runner.encode pvm_state_encoding pvm_state tree let out_encoding = @@ -323,7 +340,13 @@ struct payload = String.to_bytes message; }) in - pvm_state.tick_state + (* TODO: https://gitlab.com/tezos/tezos/-/issues/3608 + The goal is to (1) clean-up correctly the PVM state, + and (2) to read a complete inbox. *) + (* Go back to decoding *) + Decode + (Tezos_webassembly_interpreter.Decode.initial_decode_kont + ~name:wasm_main_module_name) | Decode _ -> Lwt.return (Stuck (Invalid_state "No input required during decoding")) @@ -332,6 +355,8 @@ struct (Stuck (Invalid_state "No input required during initialization")) | Stuck _ -> Lwt.return pvm_state.tick_state in + (* See {{Note tick state clean-up}} *) + let* tree = T.remove tree ["wasm"] in (* Encode the input in the tree under [input/level/id]. *) let* tree = Tree_encoding_runner.encode diff --git a/src/lib_webassembly/binary/decode.ml b/src/lib_webassembly/binary/decode.ml index e12d526fda50e6b5e35cdc48967a41d5c3b85288..1286d7b99dac94fd81bac11549579a1899c0155d 100644 --- a/src/lib_webassembly/binary/decode.ml +++ b/src/lib_webassembly/binary/decode.ml @@ -1943,7 +1943,11 @@ type module_kont = | MKField : ('a, vec_repr) field_type * size * 'a lazy_vec_kont -> module_kont (** Section currently parsed, accumulating each element from the underlying vector. *) | MKElaborateFunc : - var Vector.t * func Vector.t * func lazy_vec_kont * bool + var Vector.t + * func Vector.t + * func lazy_vec_kont + * instr lazy_vec_kont lazy_vec_kont option + * bool -> module_kont (** Elaboration of functions from the code section with their declared type in the func section, and accumulating invariants conditions associated to @@ -2099,6 +2103,7 @@ let module_step bytes state = ( func_types, func_bodies, init_lazy_vec (Vector.num_elements func_types), + None, true ) | Some ty -> next @@ MKFieldStart ty)) (* Parsing of fields vector. *) @@ -2260,24 +2265,91 @@ let module_step bytes state = let* code_kont = code_step s allocs code_kont in next @@ MKCode (code_kont, pos, size, curr_vec) | MKElaborateFunc - (_ft, _fb, (LazyVec {vector = func_types; _} as vec), no_datas_in_func) + ( _ft, + _fb, + (LazyVec {vector = func_types; _} as vec), + None, + no_datas_in_func ) when is_end_of_vec vec -> next @@ MKBuild (Some func_types, no_datas_in_func) - | MKElaborateFunc (fts, fbs, (LazyVec {offset; _} as vec), no_datas_in_func) - -> + | MKElaborateFunc + (fts, fbs, (LazyVec {offset; _} as vec), None, no_datas_in_func) -> let* ft = Vector.get offset fts in let* fb = Vector.get offset fbs in let fb' = Source.({fb.it with ftype = ft} @@ fb.at) in - (* TODO: https://gitlab.com/tezos/tezos/-/issues/3387 - `Free` shouldn't be part of the PVM. - *) - let* free = Free.func allocs.blocks fb' in - next - @@ MKElaborateFunc - ( fts, - fbs, - lazy_vec_step fb' vec, - no_datas_in_func && free.datas = Free.Set.empty ) + if no_datas_in_func then + let (Block_label body) = fb'.it.body in + let* instrs = Vector.get body allocs.blocks in + next + @@ MKElaborateFunc + ( fts, + fbs, + lazy_vec_step fb' vec, + Some + (LazyVec + { + offset = 0l; + vector = + Vector.singleton + (LazyVec {offset = 0l; vector = instrs}); + }), + no_datas_in_func ) + else + next + @@ MKElaborateFunc + (fts, fbs, lazy_vec_step fb' vec, None, no_datas_in_func) + | MKElaborateFunc (fts, fbs, vec, Some vec', no_datas_in_func) + when is_end_of_vec vec' -> + next @@ MKElaborateFunc (fts, fbs, vec, None, no_datas_in_func) + | MKElaborateFunc + (fts, fbs, vec, Some (LazyVec {offset; vector}), no_datas_in_func) -> + let* (LazyVec {offset = i; vector = block} as veci) = + Vector.get offset vector + in + if is_end_of_vec veci then + next + @@ MKElaborateFunc + ( fts, + fbs, + vec, + Some (LazyVec {offset = Int32.succ offset; vector}), + no_datas_in_func ) + else + let* instr = Vector.get i block in + + let rec push vec = function + | Block_label x :: rst -> + let* instrs = Vector.get x allocs.blocks in + let vec, _ = + Vector.append (LazyVec {offset = 0l; vector = instrs}) vec + in + push vec rst + | [] -> Lwt.return vec + in + let no_data e = + match e.Source.it with + | MemoryInit _ | DataDrop _ -> (false, []) + | Block (_, es) | Loop (_, es) -> (true, [es]) + | If (_, es1, es2) -> (true, [es1; es2]) + | _ -> (true, []) + in + let no_data, new_blocks = no_data instr in + let* vector = push vector new_blocks in + let vector = + Vector.set + offset + (LazyVec {offset = Int32.succ i; vector = block}) + vector + in + let no_datas_in_func = no_data && no_datas_in_func in + next + @@ MKElaborateFunc + ( fts, + fbs, + vec, + (if no_datas_in_func then Some (LazyVec {offset; vector}) + else None), + no_datas_in_func ) | MKBuild (funcs, no_datas_in_func) -> let { types; diff --git a/src/lib_webassembly/binary/decode.mli b/src/lib_webassembly/binary/decode.mli index 1fc575e5d045731d94def67a2d46f3144a1ae05b..5357da77bc618e58e5a98afb751e6abfd8be8b7b 100644 --- a/src/lib_webassembly/binary/decode.mli +++ b/src/lib_webassembly/binary/decode.mli @@ -223,7 +223,11 @@ type module_kont = | MKField : ('a, vec_repr) field_type * size * 'a lazy_vec_kont -> module_kont (** Section currently parsed, accumulating each element from the underlying vector. *) | MKElaborateFunc : - Ast.var Vector.t * Ast.func Vector.t * Ast.func lazy_vec_kont * bool + Ast.var Vector.t + * Ast.func Vector.t + * Ast.func lazy_vec_kont + * Ast.instr lazy_vec_kont lazy_vec_kont option + * bool -> module_kont (** Elaboration of functions from the code section with their declared type in the func section, and accumulating invariants conditions associated to diff --git a/src/lib_webassembly/exec/eval.ml b/src/lib_webassembly/exec/eval.ml index 8ac41a59964964881c2b27bfd80cb893eb8a275f..7454116a340ed6198621195c2eb4de2f5d022be2 100644 --- a/src/lib_webassembly/exec/eval.ml +++ b/src/lib_webassembly/exec/eval.ml @@ -5,6 +5,78 @@ open Instance open Ast open Source +(* Kontinuations *) + +type ('a, 'b) map_kont = { + origin : 'a Vector.t; + destination : 'b Vector.t; + offset : int32; +} + +let map_kont v = + {origin = v; destination = Vector.create (Vector.num_elements v); offset = 0l} + +let map_completed {origin; offset; _} = offset = Vector.num_elements origin + +(* Note: For a given [map_kont] value, it is expected that the same + step function is systematically used. That is, if you start using + [map_step] for instance, you cannot use [map_rev_step] for this + value. *) + +let map_step {origin; destination; offset} f = + let open Lwt.Syntax in + let+ x = Vector.get offset origin in + let destination = Vector.set offset (f x) destination in + {origin; destination; offset = Int32.succ offset} + +let map_rev_step {origin; destination; offset} f = + let open Lwt.Syntax in + let+ x = Vector.get offset origin in + let last = Int32.pred (Vector.num_elements origin) in + let destination = Vector.set (Int32.sub last offset) (f x) destination in + {origin; destination; offset = Int32.succ offset} + +let map_i_step {origin; destination; offset} f = + let open Lwt.Syntax in + let+ x = Vector.get offset origin in + let destination = Vector.set offset (f offset x) destination in + {origin; destination; offset = Int32.succ offset} + +let map_i_s_step {origin; destination; offset} f = + let open Lwt.Syntax in + let* x = Vector.get offset origin in + let+ y = f offset x in + let destination = Vector.set offset y destination in + {origin; destination; offset = Int32.succ offset} + +type 'a concat_kont = { + lv : 'a Vector.t; + rv : 'a Vector.t; + res : 'a Vector.t; + offset : int32; +} + +let concat_kont lv rv = + let lv_len = Vector.num_elements lv in + let rv_len = Vector.num_elements rv in + let len = Int32.(add lv_len rv_len) in + if Int32.(unsigned_compare len lv_len < 0 || unsigned_compare len rv_len < 0) + then raise Lazy_vector.SizeOverflow + else {lv; rv; res = Vector.create len; offset = 0l} + +let concat_step {lv; rv; res; offset} = + let lv_len = Vector.num_elements lv in + let+ x = + if offset < lv_len then Vector.get offset lv + else Vector.get Int32.(sub offset lv_len) rv + in + {lv; rv; res = Vector.set offset x res; offset = Int32.succ offset} + +let concat_completed {lv; rv; offset; _} = + let lv_len = Vector.num_elements lv in + let rv_len = Vector.num_elements rv in + Int32.add lv_len rv_len <= offset + (* Errors *) module Link = Error.Make () @@ -62,13 +134,9 @@ let numeric_error at = function (* Administrative Expressions & Configurations *) -type 'a stack = 'a list +type frame = {inst : module_key; locals : value ref Vector.t} -type frame = {inst : module_key; locals : value ref list} - -type code = value stack * admin_instr list - -and admin_instr = admin_instr' phrase +type admin_instr = admin_instr' phrase and admin_instr' = | From_block of block_label * int32 @@ -76,40 +144,123 @@ and admin_instr' = | Refer of ref_ | Invoke of func_inst | Trapping of string - | Returning of value stack - | Breaking of int32 * value stack - | Label of int32 * instr list * code - | Frame of int32 * frame * code + | Returning of value Vector.t + | Breaking of int32 * value Vector.t + +type code = value Vector.t * admin_instr Vector.t + +type label = { + label_arity : int32 option; + label_frame_specs : frame; + label_break : instr option; + label_code : code; +} + +type ongoing = Ongoing_kind + +type finished = Finished_kind + +type _ label_kont = + | Label_stack : label * label Vector.t -> ongoing label_kont + | Label_result : value Vector.t -> finished label_kont + | Label_trapped : string phrase -> finished label_kont + +let label_kont label = Label_stack (label, Vector.empty ()) + +type 'a frame_stack = { + frame_arity : int32 option; + frame_specs : frame; + frame_label_kont : 'a label_kont; +} + +type invoke_step_kont = + | Inv_start of {func : func_inst; code : code} + | Inv_prepare_locals of { + arity : int32; + args : value Vector.t; + vs : value Vector.t; + instructions : admin_instr Vector.t; + inst : module_key; + func : func; + locals_kont : (value_type, value ref) map_kont; + } + | Inv_prepare_args of { + arity : int32; + vs : value Vector.t; + instructions : admin_instr Vector.t; + inst : module_key; + func : func; + locals : value ref Vector.t; + args_kont : (value, value ref) map_kont; + } + | Inv_concat of { + arity : int32; + vs : value Vector.t; + instructions : admin_instr Vector.t; + inst : module_key; + func : func; + concat_kont : value ref concat_kont; + } + | Inv_stop of {code : code; fresh_frame : ongoing frame_stack option} + +type label_step_kont = + | LS_Start : ongoing label_kont -> label_step_kont + | LS_Craft_frame of ongoing label_kont * invoke_step_kont + | LS_Push_frame of ongoing label_kont * ongoing frame_stack + | LS_Consolidate_top of + label * value concat_kont * admin_instr Vector.t * label Vector.t + | LS_Modify_top : 'a label_kont -> label_step_kont + +type step_kont = + | SK_Start : 'a frame_stack * ongoing frame_stack Vector.t -> step_kont + | SK_Next : + 'a frame_stack * ongoing frame_stack Vector.t * label_step_kont + -> step_kont + | SK_Consolidate_label_result of + ongoing frame_stack + * ongoing frame_stack Vector.t + * label + * value concat_kont + * admin_instr Vector.t + * label Vector.t + | SK_Result of value Vector.t + | SK_Trapped of string phrase type config = { - frame : frame; input : input_inst; output : output_inst; - code : code; + step_kont : step_kont; host_funcs : Host_funcs.registry; - budget : int; (* to model stack overflow *) + stack_size_limit : int; } let frame inst locals = {inst; locals} let config ?(input = Input_buffer.alloc ()) ?(output = Output_buffer.alloc ()) - host_funcs inst vs es = + host_funcs ?frame_arity inst vs es = + let frame = frame inst (Vector.empty ()) in + let label_kont = + label_kont + { + label_arity = frame_arity; + label_frame_specs = frame; + label_code = (vs, es); + label_break = None; + } + in + let frame_stack = + {frame_arity; frame_specs = frame; frame_label_kont = label_kont} + in { - frame = frame inst []; input; output; - code = (vs, es); - budget = 300; + step_kont = SK_Start (frame_stack, Vector.empty ()); host_funcs; + stack_size_limit = 300; } let plain e = Plain e.it @@ e.at -let lookup category list x = - try Lib.List32.nth list x.it - with Failure _ -> - Crash.error x.at ("undefined " ^ category ^ " " ^ Int32.to_string x.it) - let lookup_intmap category store x = Lwt.catch (fun () -> Instance.Vector.get x.it store) @@ -137,7 +288,7 @@ let elem (inst : module_inst) x = lookup_intmap "element segment" inst.elems x let data (inst : module_inst) x = lookup_intmap "data segment" inst.datas x -let local (frame : frame) x = lookup "local" frame.locals x +let local (frame : frame) x = lookup_intmap "local" frame.locals x let any_ref inst x i at = Lwt.catch @@ -167,11 +318,121 @@ let block_type inst bt = | ValBlockType None -> FuncType (empty (), empty ()) |> Lwt.return | ValBlockType (Some t) -> FuncType (empty (), singleton t) |> Lwt.return -let take n (vs : 'a stack) at = - try Lib.List32.take n vs with Failure _ -> Crash.error at "stack underflow" +let vmtake n vs = match n with Some n -> Vector.split vs n |> fst | None -> vs -let drop n (vs : 'a stack) at = - try Lib.List32.drop n vs with Failure _ -> Crash.error at "stack underflow" +let invoke_step (module_reg : module_reg) c frame at = function + | Inv_stop _ -> assert false + | Inv_start {func; code = vs, es} -> ( + let (FuncType (ins, out)) = func_type_of func in + let n1, n2 = + (Instance.Vector.num_elements ins, Instance.Vector.num_elements out) + in + let args, vs' = Vector.split vs n1 in + match func with + | Func.AstFunc (_, inst', f) -> + Lwt.return + (Inv_prepare_locals + { + arity = n2; + args; + vs = vs'; + instructions = es; + inst = inst'; + func = f; + locals_kont = map_kont f.it.locals; + }) + | Func.HostFunc (_, global_name) -> + Lwt.catch + (fun () -> + let (Host_funcs.Host_func f) = + Host_funcs.lookup ~global_name c.host_funcs + in + let* inst = resolve_module_ref module_reg frame.inst in + let* args = Vector.to_list args in + let+ res = f c.input c.output inst.memories (List.rev args) in + let vs' = Vector.prepend_list res vs' in + Inv_stop {code = (vs', es); fresh_frame = None}) + (function Crash (_, msg) -> Crash.error at msg | exn -> raise exn)) + | Inv_prepare_locals + { + arity = n2; + args; + vs = vs'; + instructions = es; + inst = inst'; + func = f; + locals_kont; + } + when map_completed locals_kont -> + Lwt.return + (Inv_prepare_args + { + arity = n2; + vs = vs'; + instructions = es; + inst = inst'; + func = f; + locals = locals_kont.destination; + args_kont = map_kont args; + }) + | Inv_prepare_locals {arity; args; vs; instructions; inst; func; locals_kont} + -> + let+ locals_kont = + map_step locals_kont (fun x -> ref (default_value x)) + in + Inv_prepare_locals + {arity; args; vs; instructions; inst; func; locals_kont} + | Inv_prepare_args {arity; vs; instructions; inst; func; locals; args_kont} + when map_completed args_kont -> + Lwt.return + (Inv_concat + { + arity; + vs; + instructions; + inst; + func; + concat_kont = concat_kont args_kont.destination locals; + }) + | Inv_prepare_args tick -> + let+ args_kont = map_rev_step tick.args_kont ref in + Inv_prepare_args {tick with args_kont} + | Inv_concat + { + arity = n2; + vs = vs'; + instructions = es; + inst = inst'; + func = f; + concat_kont; + } + when concat_completed concat_kont -> + let frame' = {inst = inst'; locals = concat_kont.res} in + Lwt.return + (Inv_stop + { + code = (vs', es); + fresh_frame = + Some + { + frame_arity = Some n2; + frame_specs = frame'; + frame_label_kont = + label_kont + { + label_arity = Some n2; + label_frame_specs = frame'; + label_break = None; + label_code = + ( Vector.empty (), + Vector.singleton + (From_block (f.it.body, 0l) @@ f.at) ); + }; + }; + }) + | Inv_concat tick -> + let+ concat_kont = concat_step tick.concat_kont in + Inv_concat {tick with concat_kont} (* Evaluation *) @@ -213,663 +474,912 @@ let elem_oob module_reg frame x i n = (I64.add (I64_convert.extend_i32_u i) (I64_convert.extend_i32_u n)) (Int64.of_int32 (Instance.Vector.num_elements !elem)) -let rec step (module_reg : module_reg) (c : config) : config Lwt.t = - let {frame; code = vs, es; _} = c in - match es with - | {it = From_block (Block_label b, i); at} :: es -> +let vector_pop_map v f at = + if 1l <= Vector.num_elements v then + let+ hd, v = Vector.pop v in + match f hd with + | Some r -> (r, v) + | None -> Crash.error at "missing or ill-typed operand on stack" + else Crash.error at "missing or ill-typed operand on stack" + +let num = function Num n -> Some n | _ -> None + +let num_i32 = function Num (I32 i) -> Some i | _ -> None + +let ref_ = function Ref r -> Some r | _ -> None + +let vec = function Vec v -> Some v | _ -> None + +let vec_v128 = function Vec (V128 v) -> Some v | _ -> None + +(** [step_instr module_reg label vs at e es stack] returns the new + state of the label stack [label, stack] for a given [frame], by + executing the WASM instruction [e] on top of the admin instr + stack [es] and value stack [vs]. *) +let step_instr module_reg label vs at e' es_rst stack : 'a label_kont Lwt.t = + let label_kont_with_code vs es' = + Label_stack + ({label with label_code = (vs, Vector.prepend_list es' es_rst)}, stack) + in + + let return_label_kont_with_code vs es' = + Lwt.return (label_kont_with_code vs es') + in + + let frame = label.label_frame_specs in + + match e' with + | Unreachable -> + return_label_kont_with_code vs [Trapping "unreachable executed" @@ at] + | Nop -> return_label_kont_with_code vs [] + | Block (bt, es') -> let* inst = resolve_module_ref module_reg frame.inst in - let* block = Vector.get b inst.allocations.blocks in - let length = Vector.num_elements block in - if i = length then Lwt.return {c with code = (vs, es)} - else - let+ instr = Vector.get i block in + let+ (FuncType (ts1, ts2)) = block_type inst bt in + let n1 = Lazy_vector.Int32Vector.num_elements ts1 in + let n2 = Lazy_vector.Int32Vector.num_elements ts2 in + let args, vs' = Vector.split vs n1 in + let label' = { - c with - code = - ( vs, - (Plain instr.it @@ instr.at) - :: {it = From_block (Block_label b, Int32.succ i); at} - :: es ); + label_arity = Some n2; + label_break = None; + label_code = (args, Vector.singleton (From_block (es', 0l) @@ at)); + label_frame_specs = frame; } - | e :: es -> step_resolved module_reg c frame vs e es - | [] -> Lwt.return c - -and step_resolved module_reg (c : config) frame vs e es : config Lwt.t = - let+ vs', es' = - match (e.it, vs) with - | From_block _, _ -> assert false (* resolved by [step] *) - | Plain e', vs -> ( - match (e', vs) with - | Unreachable, vs -> - Lwt.return (vs, [Trapping "unreachable executed" @@ e.at]) - | Nop, vs -> Lwt.return (vs, []) - | Block (bt, es'), vs -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ (FuncType (ts1, ts2)) = block_type inst bt in - let n1 = Lazy_vector.Int32Vector.num_elements ts1 in - let n2 = Lazy_vector.Int32Vector.num_elements ts2 in - let args, vs' = (take n1 vs e.at, drop n1 vs e.at) in - ( vs', - [Label (n2, [], (args, [From_block (es', 0l) @@ e.at])) @@ e.at] - ) - | Loop (bt, es'), vs -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ (FuncType (ts1, _)) = block_type inst bt in - let n1 = Lazy_vector.Int32Vector.num_elements ts1 in - let args, vs' = (take n1 vs e.at, drop n1 vs e.at) in - ( vs', - [ - Label (n1, [e' @@ e.at], (args, [From_block (es', 0l) @@ e.at])) - @@ e.at; - ] ) - | If (bt, es1, es2), Num (I32 i) :: vs' -> - Lwt.return - (if i = 0l then (vs', [Plain (Block (bt, es2)) @@ e.at]) - else (vs', [Plain (Block (bt, es1)) @@ e.at])) - | Br x, vs -> Lwt.return ([], [Breaking (x.it, vs) @@ e.at]) - | BrIf x, Num (I32 i) :: vs' -> - Lwt.return - (if i = 0l then (vs', []) else (vs', [Plain (Br x) @@ e.at])) - | BrTable (xs, x), Num (I32 i) :: vs' -> - Lwt.return - (if I32.ge_u i (Lib.List32.length xs) then - (vs', [Plain (Br x) @@ e.at]) - else (vs', [Plain (Br (Lib.List32.nth xs i)) @@ e.at])) - | Return, vs -> Lwt.return ([], [Returning vs @@ e.at]) - | Call x, vs -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ func = func inst x in - (vs, [Invoke func @@ e.at]) - | CallIndirect (x, y), Num (I32 i) :: vs -> - let* inst = resolve_module_ref module_reg frame.inst in - let* func = func_ref inst x i e.at and* type_ = type_ inst y in - let+ check_eq = Types.func_types_equal type_ (Func.type_of func) in - if not check_eq then - (vs, [Trapping "indirect call type mismatch" @@ e.at]) - else (vs, [Invoke func @@ e.at]) - | Drop, _ :: vs' -> Lwt.return (vs', []) - | Select _, Num (I32 i) :: v2 :: v1 :: vs' -> - Lwt.return (if i = 0l then (v2 :: vs', []) else (v1 :: vs', [])) - | LocalGet x, vs -> Lwt.return (!(local frame x) :: vs, []) - | LocalSet x, v :: vs' -> - Lwt.return - (local frame x := v ; - (vs', [])) - | LocalTee x, v :: vs' -> - Lwt.return - (local frame x := v ; - (v :: vs', [])) - | GlobalGet x, vs -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ glob = global inst x in - let value = Global.load glob in - (value :: vs, []) - | GlobalSet x, v :: vs' -> - Lwt.catch - (fun () -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ glob = global inst x in - Global.store glob v ; - (vs', [])) - (function - | Global.NotMutable -> - Crash.error e.at "write to immutable global" - | Global.Type -> - Crash.error e.at "type mismatch at global write" - | exn -> Lwt.fail exn) - | TableGet x, Num (I32 i) :: vs' -> - Lwt.catch - (fun () -> - let* inst = resolve_module_ref module_reg frame.inst in - let* tbl = table inst x in - let+ value = Table.load tbl i in - (Ref value :: vs', [])) - (fun exn -> - Lwt.return (vs', [Trapping (table_error e.at exn) @@ e.at])) - | TableSet x, Ref r :: Num (I32 i) :: vs' -> - Lwt.catch - (fun () -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ tbl = table inst x in - Table.store tbl i r ; - (vs', [])) - (fun exn -> - Lwt.return (vs', [Trapping (table_error e.at exn) @@ e.at])) - | TableSize x, vs -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ tbl = table inst x in - (Num (I32 (Table.size tbl)) :: vs, []) - | TableGrow x, Num (I32 delta) :: Ref r :: vs' -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ tab = table inst x in - let old_size = Table.size tab in - let result = - try - Table.grow tab delta r ; - old_size - with Table.SizeOverflow | Table.SizeLimit | Table.OutOfMemory -> - -1l - in - (Num (I32 result) :: vs', []) - | TableFill x, Num (I32 n) :: Ref r :: Num (I32 i) :: vs' -> - let+ oob = table_oob module_reg frame x i n in - if oob then (vs', [Trapping (table_error e.at Table.Bounds) @@ e.at]) - else if n = 0l then (vs', []) - else - let _ = assert (I32.lt_u i 0xffff_ffffl) in - ( vs', - List.map - (at e.at) - [ - Plain (Const (I32 i @@ e.at)); - Refer r; - Plain (TableSet x); - Plain (Const (I32 (I32.add i 1l) @@ e.at)); - Refer r; - Plain (Const (I32 (I32.sub n 1l) @@ e.at)); - Plain (TableFill x); - ] ) - | TableCopy (x, y), Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' -> - let+ oob_d = table_oob module_reg frame x d n - and+ oob_s = table_oob module_reg frame y s n in - if oob_d || oob_s then - (vs', [Trapping (table_error e.at Table.Bounds) @@ e.at]) - else if n = 0l then (vs', []) - else if I32.le_u d s then - ( vs', - List.map - (at e.at) - [ - Plain (Const (I32 d @@ e.at)); - Plain (Const (I32 s @@ e.at)); - Plain (TableGet y); - Plain (TableSet x); - Plain (Const (I32 (I32.add d 1l) @@ e.at)); - Plain (Const (I32 (I32.add s 1l) @@ e.at)); - Plain (Const (I32 (I32.sub n 1l) @@ e.at)); - Plain (TableCopy (x, y)); - ] ) - else - (* d > s *) - ( vs', - List.map - (at e.at) - [ - Plain (Const (I32 (I32.add d 1l) @@ e.at)); - Plain (Const (I32 (I32.add s 1l) @@ e.at)); - Plain (Const (I32 (I32.sub n 1l) @@ e.at)); - Plain (TableCopy (x, y)); - Plain (Const (I32 d @@ e.at)); - Plain (Const (I32 s @@ e.at)); - Plain (TableGet y); - Plain (TableSet x); - ] ) - | TableInit (x, y), Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' -> - let* oob_d = table_oob module_reg frame x d n in - let* oob_s = elem_oob module_reg frame y s n in - if oob_d || oob_s then - Lwt.return - (vs', [Trapping (table_error e.at Table.Bounds) @@ e.at]) - else if n = 0l then Lwt.return (vs', []) - else - let* inst = resolve_module_ref module_reg frame.inst in - let* seg = elem inst y in - let+ value = Instance.Vector.get s !seg in - ( vs', - List.map - (at e.at) - [ - Plain (Const (I32 d @@ e.at)); - (* Note, the [Instance.Vector.get] is logarithmic in the number of - contained elements in [seg]. However, in a scenario where the PVM - runs, only the element that will be looked up is in the map - making the look up cheap. *) - Refer value; - Plain (TableSet x); - Plain (Const (I32 (I32.add d 1l) @@ e.at)); - Plain (Const (I32 (I32.add s 1l) @@ e.at)); - Plain (Const (I32 (I32.sub n 1l) @@ e.at)); - Plain (TableInit (x, y)); - ] ) - | ElemDrop x, vs -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ seg = elem inst x in - seg := Instance.Vector.create 0l ; - (vs, []) - | Load {offset; ty; pack; _}, Num (I32 i) :: vs' -> - let* inst = resolve_module_ref module_reg frame.inst in - let* mem = memory inst (0l @@ e.at) in - Lwt.catch - (fun () -> - let+ n = - match pack with - | None -> Memory.load_num mem i offset ty - | Some (sz, ext) -> - Memory.load_num_packed sz ext mem i offset ty - in - (Num n :: vs', [])) - (fun exn -> - Lwt.return (vs', [Trapping (memory_error e.at exn) @@ e.at])) - | Store {offset; pack; _}, Num n :: Num (I32 i) :: vs' -> - let* inst = resolve_module_ref module_reg frame.inst in - let* mem = memory inst (0l @@ e.at) in - Lwt.catch - (fun () -> - let+ () = - match pack with - | None -> Memory.store_num mem i offset n - | Some sz -> Memory.store_num_packed sz mem i offset n - in - (vs', [])) - (fun exn -> - Lwt.return (vs', [Trapping (memory_error e.at exn) @@ e.at])) - | VecLoad {offset; ty; pack; _}, Num (I32 i) :: vs' -> - let* inst = resolve_module_ref module_reg frame.inst in - let* mem = memory inst (0l @@ e.at) in - Lwt.catch - (fun () -> - let+ v = - match pack with - | None -> Memory.load_vec mem i offset ty - | Some (sz, ext) -> - Memory.load_vec_packed sz ext mem i offset ty - in - (Vec v :: vs', [])) - (fun exn -> - Lwt.return (vs', [Trapping (memory_error e.at exn) @@ e.at])) - | VecStore {offset; _}, Vec v :: Num (I32 i) :: vs' -> - let* inst = resolve_module_ref module_reg frame.inst in - let* mem = memory inst (0l @@ e.at) in - Lwt.catch - (fun () -> - let+ () = Memory.store_vec mem i offset v in - (vs', [])) - (fun exn -> - Lwt.return (vs', [Trapping (memory_error e.at exn) @@ e.at])) - | VecLoadLane ({offset; pack; _}, j), Vec (V128 v) :: Num (I32 i) :: vs' - -> - let* inst = resolve_module_ref module_reg frame.inst in - let* mem = memory inst (0l @@ e.at) in - Lwt.catch - (fun () -> - let+ v = - match pack with - | Pack8 -> - let+ mem = - Memory.load_num_packed Pack8 SX mem i offset I32Type - in - V128.I8x16.replace_lane j v (I32Num.of_num 0 mem) - | Pack16 -> - let+ mem = - Memory.load_num_packed Pack16 SX mem i offset I32Type - in - V128.I16x8.replace_lane j v (I32Num.of_num 0 mem) - | Pack32 -> - let+ mem = Memory.load_num mem i offset I32Type in - V128.I32x4.replace_lane j v (I32Num.of_num 0 mem) - | Pack64 -> - let+ mem = Memory.load_num mem i offset I64Type in - V128.I64x2.replace_lane j v (I64Num.of_num 0 mem) + in + Label_stack + (label', Vector.cons {label with label_code = (vs', es_rst)} stack) + | Loop (bt, es') -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ (FuncType (ts1, _)) = block_type inst bt in + let n1 = Lazy_vector.Int32Vector.num_elements ts1 in + let args, vs' = Vector.split vs n1 in + let label' = + { + label_arity = Some n1; + label_break = Some (e' @@ at); + label_code = (args, Vector.singleton (From_block (es', 0l) @@ at)); + label_frame_specs = frame; + } + in + Label_stack + (label', Vector.cons {label with label_code = (vs', es_rst)} stack) + | If (bt, es1, es2) -> + (* Num (I32 i) :: vs' *) + let+ i, vs' = vector_pop_map vs num_i32 at in + label_kont_with_code + vs' + [ + (if i = 0l then Plain (Block (bt, es2)) @@ at + else Plain (Block (bt, es1)) @@ at); + ] + | Br x -> + return_label_kont_with_code (Vector.empty ()) [Breaking (x.it, vs) @@ at] + | BrIf x -> + (* Num (I32 i) :: vs' *) + let+ i, vs' = vector_pop_map vs num_i32 at in + label_kont_with_code vs' (if i = 0l then [] else [Plain (Br x) @@ at]) + | BrTable (xs, x) -> + (* Num (I32 i) :: vs' *) + let+ i, vs' = vector_pop_map vs num_i32 at in + label_kont_with_code + vs' + (if I32.ge_u i (Lib.List32.length xs) then [Plain (Br x) @@ at] + else [Plain (Br (Lib.List32.nth xs i)) @@ at]) + | Return -> return_label_kont_with_code (Vector.empty ()) [Returning vs @@ at] + | Call x -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ func = func inst x in + label_kont_with_code vs [Invoke func @@ at] + | CallIndirect (x, y) -> + (* Num (I32 i) :: vs' *) + let* i, vs' = vector_pop_map vs num_i32 at in + let* inst = resolve_module_ref module_reg frame.inst in + let* func = func_ref inst x i at in + let* type_ = type_ inst y in + let+ check_eq = Types.func_types_equal type_ (Func.type_of func) in + label_kont_with_code + vs' + (if not check_eq then [Trapping "indirect call type mismatch" @@ at] + else [Invoke func @@ at]) + | Drop -> + (* _ :: vs' *) + let+ _, vs' = vector_pop_map vs Option.some at in + label_kont_with_code vs' [] + | Select _ -> + (* Num (I32 i) :: v2 :: v1 :: vs' *) + let* i, vs = vector_pop_map vs num_i32 at in + let* v2, vs = vector_pop_map vs Option.some at in + let+ v1, vs' = vector_pop_map vs Option.some at in + label_kont_with_code + (if i = 0l then Vector.cons v2 vs' else Vector.cons v1 vs') + [] + | LocalGet x -> + let+ r = local frame x in + label_kont_with_code (Vector.cons !r vs) [] + | LocalSet x -> + (* v :: vs' *) + let* v, vs' = vector_pop_map vs Option.some at in + let+ r = local frame x in + r := v ; + label_kont_with_code vs' [] + | LocalTee x -> + (* v :: vs' *) + let* v, vs' = vector_pop_map vs Option.some at in + let+ r = local frame x in + r := v ; + label_kont_with_code (Vector.cons v vs') [] + | GlobalGet x -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ glob = global inst x in + let value = Global.load glob in + label_kont_with_code (Vector.cons value vs) [] + | GlobalSet x -> + (* v :: vs' *) + let* v, vs' = vector_pop_map vs Option.some at in + Lwt.catch + (fun () -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ glob = global inst x in + Global.store glob v ; + label_kont_with_code vs' []) + (function + | Global.NotMutable -> Crash.error at "write to immutable global" + | Global.Type -> Crash.error at "type mismatch at global write" + | exn -> Lwt.fail exn) + | TableGet x -> + (* Num (I32 i) :: vs' *) + let* i, vs' = vector_pop_map vs num_i32 at in + Lwt.catch + (fun () -> + let* inst = resolve_module_ref module_reg frame.inst in + let* tbl = table inst x in + let+ value = Table.load tbl i in + label_kont_with_code (Vector.cons (Ref value) vs') []) + (fun exn -> + return_label_kont_with_code vs' [Trapping (table_error at exn) @@ at]) + | TableSet x -> + (* Ref r :: Num (I32 i) :: vs' *) + let* r, vs = vector_pop_map vs ref_ at in + let* i, vs' = vector_pop_map vs num_i32 at in + Lwt.catch + (fun () -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ tbl = table inst x in + Table.store tbl i r ; + label_kont_with_code vs' []) + (fun exn -> + return_label_kont_with_code vs' [Trapping (table_error at exn) @@ at]) + | TableSize x -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ tbl = table inst x in + label_kont_with_code (Vector.cons (Num (I32 (Table.size tbl))) vs) [] + | TableGrow x -> + (* Num (I32 delta) :: Ref r :: vs' *) + let* delta, vs = vector_pop_map vs num_i32 at in + let* r, vs' = vector_pop_map vs ref_ at in + let* inst = resolve_module_ref module_reg frame.inst in + let+ tab = table inst x in + let old_size = Table.size tab in + let result = + try + Table.grow tab delta r ; + old_size + with Table.SizeOverflow | Table.SizeLimit | Table.OutOfMemory -> -1l + in + label_kont_with_code (Vector.cons (Num (I32 result)) vs') [] + | TableFill x -> + (* Num (I32 n) :: Ref r :: Num (I32 i) :: vs' *) + let* n, vs = vector_pop_map vs num_i32 at in + let* r, vs = vector_pop_map vs ref_ at in + let* i, vs' = vector_pop_map vs num_i32 at in + let+ oob = table_oob module_reg frame x i n in + if oob then + label_kont_with_code vs' [Trapping (table_error at Table.Bounds) @@ at] + else if n = 0l then label_kont_with_code vs' [] + else + let _ = assert (I32.lt_u i 0xffff_ffffl) in + label_kont_with_code + vs' + (List.map + (Source.at at) + [ + Plain (Const (I32 i @@ at)); + Refer r; + Plain (TableSet x); + Plain (Const (I32 (I32.add i 1l) @@ at)); + Refer r; + Plain (Const (I32 (I32.sub n 1l) @@ at)); + Plain (TableFill x); + ]) + | TableCopy (x, y) -> + (* Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' *) + let* n, vs = vector_pop_map vs num_i32 at in + let* s, vs = vector_pop_map vs num_i32 at in + let* d, vs' = vector_pop_map vs num_i32 at in + let+ oob_d = table_oob module_reg frame x d n + and+ oob_s = table_oob module_reg frame y s n in + label_kont_with_code + vs' + (if oob_d || oob_s then [Trapping (table_error at Table.Bounds) @@ at] + else if n = 0l then [] + else if I32.le_u d s then + List.map + (Source.at at) + [ + Plain (Const (I32 d @@ at)); + Plain (Const (I32 s @@ at)); + Plain (TableGet y); + Plain (TableSet x); + Plain (Const (I32 (I32.add d 1l) @@ at)); + Plain (Const (I32 (I32.add s 1l) @@ at)); + Plain (Const (I32 (I32.sub n 1l) @@ at)); + Plain (TableCopy (x, y)); + ] + else + (* d > s *) + List.map + (Source.at at) + [ + Plain (Const (I32 (I32.add d 1l) @@ at)); + Plain (Const (I32 (I32.add s 1l) @@ at)); + Plain (Const (I32 (I32.sub n 1l) @@ at)); + Plain (TableCopy (x, y)); + Plain (Const (I32 d @@ at)); + Plain (Const (I32 s @@ at)); + Plain (TableGet y); + Plain (TableSet x); + ]) + | TableInit (x, y) -> + (* Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' *) + let* n, vs = vector_pop_map vs num_i32 at in + let* s, vs = vector_pop_map vs num_i32 at in + let* d, vs' = vector_pop_map vs num_i32 at in + let* oob_d = table_oob module_reg frame x d n in + let* oob_s = elem_oob module_reg frame y s n in + if oob_d || oob_s then + return_label_kont_with_code + vs' + [Trapping (table_error at Table.Bounds) @@ at] + else if n = 0l then return_label_kont_with_code vs' [] + else + let* inst = resolve_module_ref module_reg frame.inst in + let* seg = elem inst y in + let+ value = Instance.Vector.get s !seg in + label_kont_with_code + vs' + (List.map + (Source.at at) + [ + Plain (Const (I32 d @@ at)); + (* Note, the [Instance.Vector.get] is logarithmic in the number of + contained elements in [seg]. However, in a scenario where the PVM + runs, only the element that will be looked up is in the map + making the look up cheap. *) + Refer value; + Plain (TableSet x); + Plain (Const (I32 (I32.add d 1l) @@ at)); + Plain (Const (I32 (I32.add s 1l) @@ at)); + Plain (Const (I32 (I32.sub n 1l) @@ at)); + Plain (TableInit (x, y)); + ]) + | ElemDrop x -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ seg = elem inst x in + seg := Instance.Vector.create 0l ; + label_kont_with_code vs [] + | Load {offset; ty; pack; _} -> + (* Num (I32 i) :: vs' *) + let* i, vs' = vector_pop_map vs num_i32 at in + let* inst = resolve_module_ref module_reg frame.inst in + let* mem = memory inst (0l @@ at) in + Lwt.catch + (fun () -> + let+ n = + match pack with + | None -> Memory.load_num mem i offset ty + | Some (sz, ext) -> Memory.load_num_packed sz ext mem i offset ty + in + label_kont_with_code (Vector.cons (Num n) vs') []) + (fun exn -> + return_label_kont_with_code vs' [Trapping (memory_error at exn) @@ at]) + | Store {offset; pack; _} -> + (* Num n :: Num (I32 i) :: vs' *) + let* n, vs = vector_pop_map vs num at in + let* i, vs' = vector_pop_map vs num_i32 at in + let* inst = resolve_module_ref module_reg frame.inst in + let* mem = memory inst (0l @@ at) in + Lwt.catch + (fun () -> + let+ () = + match pack with + | None -> Memory.store_num mem i offset n + | Some sz -> Memory.store_num_packed sz mem i offset n + in + label_kont_with_code vs' []) + (fun exn -> + return_label_kont_with_code vs' [Trapping (memory_error at exn) @@ at]) + | VecLoad {offset; ty; pack; _} -> + (* Num (I32 i) :: vs' *) + let* i, vs' = vector_pop_map vs num_i32 at in + let* inst = resolve_module_ref module_reg frame.inst in + let* mem = memory inst (0l @@ at) in + Lwt.catch + (fun () -> + let+ v = + match pack with + | None -> Memory.load_vec mem i offset ty + | Some (sz, ext) -> Memory.load_vec_packed sz ext mem i offset ty + in + label_kont_with_code (Vector.cons (Vec v) vs') []) + (fun exn -> + return_label_kont_with_code vs' [Trapping (memory_error at exn) @@ at]) + | VecStore {offset; _} -> + (* Vec v :: Num (I32 i) :: vs' *) + let* v, vs = vector_pop_map vs vec at in + let* i, vs' = vector_pop_map vs num_i32 at in + let* inst = resolve_module_ref module_reg frame.inst in + let* mem = memory inst (0l @@ at) in + Lwt.catch + (fun () -> + let+ () = Memory.store_vec mem i offset v in + label_kont_with_code vs' []) + (fun exn -> + return_label_kont_with_code vs' [Trapping (memory_error at exn) @@ at]) + | VecLoadLane ({offset; pack; _}, j) -> + (* Vec (V128 v) :: Num (I32 i) :: vs' *) + let* v, vs = vector_pop_map vs vec_v128 at in + let* i, vs' = vector_pop_map vs num_i32 at in + let* inst = resolve_module_ref module_reg frame.inst in + let* mem = memory inst (0l @@ at) in + Lwt.catch + (fun () -> + let+ v = + match pack with + | Pack8 -> + let+ mem = + Memory.load_num_packed Pack8 SX mem i offset I32Type in - (Vec (V128 v) :: vs', [])) - (fun exn -> - Lwt.return (vs', [Trapping (memory_error e.at exn) @@ e.at])) - | ( VecStoreLane ({offset; pack; _}, j), - Vec (V128 v) :: Num (I32 i) :: vs' ) -> - let* inst = resolve_module_ref module_reg frame.inst in - let* mem = memory inst (0l @@ e.at) in - Lwt.catch - (fun () -> - let+ () = - match pack with - | Pack8 -> - Memory.store_num_packed - Pack8 - mem - i - offset - (I32 (V128.I8x16.extract_lane_s j v)) - | Pack16 -> - Memory.store_num_packed - Pack16 - mem - i - offset - (I32 (V128.I16x8.extract_lane_s j v)) - | Pack32 -> - Memory.store_num - mem - i - offset - (I32 (V128.I32x4.extract_lane_s j v)) - | Pack64 -> - Memory.store_num - mem - i - offset - (I64 (V128.I64x2.extract_lane_s j v)) + V128.I8x16.replace_lane j v (I32Num.of_num 0 mem) + | Pack16 -> + let+ mem = + Memory.load_num_packed Pack16 SX mem i offset I32Type in - (vs', [])) - (fun exn -> - Lwt.return (vs', [Trapping (memory_error e.at exn) @@ e.at])) - | MemorySize, vs -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ mem = memory inst (0l @@ e.at) in - (Num (I32 (Memory.size mem)) :: vs, []) - | MemoryGrow, Num (I32 delta) :: vs' -> + V128.I16x8.replace_lane j v (I32Num.of_num 0 mem) + | Pack32 -> + let+ mem = Memory.load_num mem i offset I32Type in + V128.I32x4.replace_lane j v (I32Num.of_num 0 mem) + | Pack64 -> + let+ mem = Memory.load_num mem i offset I64Type in + V128.I64x2.replace_lane j v (I64Num.of_num 0 mem) + in + label_kont_with_code (Vector.cons (Vec (V128 v)) vs') []) + (fun exn -> + return_label_kont_with_code vs' [Trapping (memory_error at exn) @@ at]) + | VecStoreLane ({offset; pack; _}, j) -> + (* Vec (V128 v) :: Num (I32 i) :: vs' *) + let* v, vs = vector_pop_map vs vec_v128 at in + let* i, vs' = vector_pop_map vs num_i32 at in + let* inst = resolve_module_ref module_reg frame.inst in + let* mem = memory inst (0l @@ at) in + Lwt.catch + (fun () -> + let+ () = + match pack with + | Pack8 -> + Memory.store_num_packed + Pack8 + mem + i + offset + (I32 (V128.I8x16.extract_lane_s j v)) + | Pack16 -> + Memory.store_num_packed + Pack16 + mem + i + offset + (I32 (V128.I16x8.extract_lane_s j v)) + | Pack32 -> + Memory.store_num + mem + i + offset + (I32 (V128.I32x4.extract_lane_s j v)) + | Pack64 -> + Memory.store_num + mem + i + offset + (I64 (V128.I64x2.extract_lane_s j v)) + in + label_kont_with_code vs' []) + (fun exn -> + return_label_kont_with_code vs' [Trapping (memory_error at exn) @@ at]) + | MemorySize -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ mem = memory inst (0l @@ at) in + label_kont_with_code (Vector.cons (Num (I32 (Memory.size mem))) vs) [] + | MemoryGrow -> + (* Num (I32 delta) :: vs' *) + let* delta, vs' = vector_pop_map vs num_i32 at in + let* inst = resolve_module_ref module_reg frame.inst in + let+ mem = memory inst (0l @@ at) in + let old_size = Memory.size mem in + let result = + try + Memory.grow mem delta ; + old_size + with Memory.SizeOverflow | Memory.SizeLimit | Memory.OutOfMemory -> + -1l + in + label_kont_with_code (Vector.cons (Num (I32 result)) vs') [] + | MemoryFill -> + (* Num (I32 n) :: Num k :: Num (I32 i) :: vs' *) + let* n, vs = vector_pop_map vs num_i32 at in + let* k, vs = vector_pop_map vs num at in + let* i, vs' = vector_pop_map vs num_i32 at in + let+ oob = mem_oob module_reg frame (0l @@ at) i n in + label_kont_with_code + vs' + (if oob then [Trapping (memory_error at Memory.Bounds) @@ at] + else if n = 0l then [] + else + List.map + (Source.at at) + [ + Plain (Const (I32 i @@ at)); + Plain (Const (k @@ at)); + Plain + (Store {ty = I32Type; align = 0; offset = 0l; pack = Some Pack8}); + Plain (Const (I32 (I32.add i 1l) @@ at)); + Plain (Const (k @@ at)); + Plain (Const (I32 (I32.sub n 1l) @@ at)); + Plain MemoryFill; + ]) + | MemoryCopy -> + (* Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' *) + let* n, vs = vector_pop_map vs num_i32 at in + let* s, vs = vector_pop_map vs num_i32 at in + let* d, vs' = vector_pop_map vs num_i32 at in + let+ oob_s = mem_oob module_reg frame (0l @@ at) s n + and+ oob_d = mem_oob module_reg frame (0l @@ at) d n in + label_kont_with_code + vs' + (if oob_s || oob_d then [Trapping (memory_error at Memory.Bounds) @@ at] + else if n = 0l then [] + else if I32.le_u d s then + List.map + (Source.at at) + [ + Plain (Const (I32 d @@ at)); + Plain (Const (I32 s @@ at)); + Plain + (Load + { + ty = I32Type; + align = 0; + offset = 0l; + pack = Some (Pack8, ZX); + }); + Plain + (Store {ty = I32Type; align = 0; offset = 0l; pack = Some Pack8}); + Plain (Const (I32 (I32.add d 1l) @@ at)); + Plain (Const (I32 (I32.add s 1l) @@ at)); + Plain (Const (I32 (I32.sub n 1l) @@ at)); + Plain MemoryCopy; + ] + else + (* d > s *) + List.map + (Source.at at) + [ + Plain (Const (I32 (I32.add d 1l) @@ at)); + Plain (Const (I32 (I32.add s 1l) @@ at)); + Plain (Const (I32 (I32.sub n 1l) @@ at)); + Plain MemoryCopy; + Plain (Const (I32 d @@ at)); + Plain (Const (I32 s @@ at)); + Plain + (Load + { + ty = I32Type; + align = 0; + offset = 0l; + pack = Some (Pack8, ZX); + }); + Plain + (Store {ty = I32Type; align = 0; offset = 0l; pack = Some Pack8}); + ]) + | MemoryInit x -> + (* Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' *) + let* n, vs = vector_pop_map vs num_i32 at in + let* s, vs = vector_pop_map vs num_i32 at in + let* d, vs' = vector_pop_map vs num_i32 at in + let* mem_oob = mem_oob module_reg frame (0l @@ at) d n in + let* data_oob = data_oob module_reg frame x s n in + if mem_oob || data_oob then + return_label_kont_with_code + vs' + [Trapping (memory_error at Memory.Bounds) @@ at] + else if n = 0l then return_label_kont_with_code vs' [] + else + let* inst = resolve_module_ref module_reg frame.inst in + let* seg = data inst x in + let* seg = Ast.get_data !seg inst.allocations.datas in + let+ b = Chunked_byte_vector.load_byte seg (Int64.of_int32 s) in + let b = Int32.of_int b in + label_kont_with_code + vs' + (List.map + (Source.at at) + [ + Plain (Const (I32 d @@ at)); + Plain (Const (I32 b @@ at)); + Plain + (Store + {ty = I32Type; align = 0; offset = 0l; pack = Some Pack8}); + Plain (Const (I32 (I32.add d 1l) @@ at)); + Plain (Const (I32 (I32.add s 1l) @@ at)); + Plain (Const (I32 (I32.sub n 1l) @@ at)); + Plain (MemoryInit x); + ]) + | DataDrop x -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ seg = data inst x in + seg := Data_label 0l ; + label_kont_with_code vs [] + | RefNull t -> + return_label_kont_with_code (Vector.cons (Ref (NullRef t)) vs) [] + | RefIsNull -> ( + (* Ref r :: vs' *) + let+ r, vs' = vector_pop_map vs ref_ at in + match r with + | NullRef _ -> label_kont_with_code (Vector.cons (Num (I32 1l)) vs') [] + | _ -> label_kont_with_code (Vector.cons (Num (I32 0l)) vs') []) + | RefFunc x -> + let* inst = resolve_module_ref module_reg frame.inst in + let+ f = func inst x in + label_kont_with_code (Vector.cons (Ref (FuncRef f)) vs) [] + | Const n -> return_label_kont_with_code (Vector.cons (Num n.it) vs) [] + | Test testop -> ( + (* Num n :: vs' *) + let+ n, vs' = vector_pop_map vs num at in + try + label_kont_with_code + (Vector.cons (value_of_bool (Eval_num.eval_testop testop n)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | Compare relop -> ( + (* Num n2 :: Num n1 :: vs' *) + let* n2, vs = vector_pop_map vs num at in + let+ n1, vs' = vector_pop_map vs num at in + try + label_kont_with_code + (Vector.cons (value_of_bool (Eval_num.eval_relop relop n1 n2)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | Unary unop -> ( + (* Num n :: vs' *) + let+ n, vs' = vector_pop_map vs num at in + try + label_kont_with_code + (Vector.cons (Num (Eval_num.eval_unop unop n)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | Binary binop -> ( + (* Num n2 :: Num n1 :: vs' *) + let* n2, vs = vector_pop_map vs num at in + let+ n1, vs' = vector_pop_map vs num at in + try + label_kont_with_code + (Vector.cons (Num (Eval_num.eval_binop binop n1 n2)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | Convert cvtop -> ( + (* Num n :: vs' *) + let+ n, vs' = vector_pop_map vs num at in + try + label_kont_with_code + (Vector.cons (Num (Eval_num.eval_cvtop cvtop n)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecConst v -> return_label_kont_with_code (Vector.cons (Vec v.it) vs) [] + | VecTest testop -> ( + (* Vec n :: vs' *) + let+ n, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (value_of_bool (Eval_vec.eval_testop testop n)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecUnary unop -> ( + (* Vec n :: vs' *) + let+ n, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_unop unop n)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecBinary binop -> ( + (* Vec n2 :: Vec n1 :: vs' *) + let* n2, vs = vector_pop_map vs vec at in + let+ n1, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_binop binop n1 n2)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecCompare relop -> ( + (* Vec n2 :: Vec n1 :: vs' *) + let* n2, vs = vector_pop_map vs vec at in + let+ n1, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_relop relop n1 n2)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecConvert cvtop -> ( + (* Vec n :: vs' *) + let+ n, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_cvtop cvtop n)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecShift shiftop -> ( + (* Num s :: Vec v :: vs' *) + let* s, vs = vector_pop_map vs num at in + let+ v, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_shiftop shiftop v s)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecBitmask bitmaskop -> ( + (* Vec v :: vs' *) + let+ v, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Num (Eval_vec.eval_bitmaskop bitmaskop v)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecTestBits vtestop -> ( + (* Vec n :: vs' *) + let+ n, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (value_of_bool (Eval_vec.eval_vtestop vtestop n)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecUnaryBits vunop -> ( + (* Vec n :: vs' *) + let+ n, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_vunop vunop n)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecBinaryBits vbinop -> ( + (* Vec n2 :: Vec n1 :: vs' *) + let* n2, vs = vector_pop_map vs vec at in + let+ n1, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_vbinop vbinop n1 n2)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecTernaryBits vternop -> ( + (* Vec v3 :: Vec v2 :: Vec v1 :: vs' *) + let* v3, vs = vector_pop_map vs vec at in + let* v2, vs = vector_pop_map vs vec at in + let+ v1, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_vternop vternop v1 v2 v3)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecSplat splatop -> ( + (* Num n :: vs' *) + let+ n, vs' = vector_pop_map vs num at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_splatop splatop n)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecExtract extractop -> ( + (* Vec v :: vs' *) + let+ v, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Num (Eval_vec.eval_extractop extractop v)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + | VecReplace replaceop -> ( + (* Num r :: Vec v :: vs' *) + let* r, vs = vector_pop_map vs num at in + let+ v, vs' = vector_pop_map vs vec at in + try + label_kont_with_code + (Vector.cons (Vec (Eval_vec.eval_replaceop replaceop v r)) vs') + [] + with exn -> + label_kont_with_code vs' [Trapping (numeric_error at exn) @@ at]) + +let label_step : + module_reg -> config -> frame -> label_step_kont -> label_step_kont Lwt.t = + fun module_reg c frame label_kont -> + match label_kont with + | LS_Push_frame _ | LS_Modify_top _ -> assert false + | LS_Start (Label_stack (label, stack)) -> + let frame = label.label_frame_specs in + let vs, es = label.label_code in + if 0l < Vector.num_elements es then + let* e, es = Vector.pop es in + match e.it with + | Plain e' -> + let+ kont = step_instr module_reg label vs e.at e' es stack in + LS_Modify_top kont + | From_block (Block_label b, i) -> let* inst = resolve_module_ref module_reg frame.inst in - let+ mem = memory inst (0l @@ e.at) in - let old_size = Memory.size mem in - let result = - try - Memory.grow mem delta ; - old_size - with - | Memory.SizeOverflow | Memory.SizeLimit | Memory.OutOfMemory -> - -1l - in - (Num (I32 result) :: vs', []) - | MemoryFill, Num (I32 n) :: Num k :: Num (I32 i) :: vs' -> - let+ oob = mem_oob module_reg frame (0l @@ e.at) i n in - if oob then - (vs', [Trapping (memory_error e.at Memory.Bounds) @@ e.at]) - else if n = 0l then (vs', []) - else - ( vs', - List.map - (at e.at) - [ - Plain (Const (I32 i @@ e.at)); - Plain (Const (k @@ e.at)); - Plain - (Store - { - ty = I32Type; - align = 0; - offset = 0l; - pack = Some Pack8; - }); - Plain (Const (I32 (I32.add i 1l) @@ e.at)); - Plain (Const (k @@ e.at)); - Plain (Const (I32 (I32.sub n 1l) @@ e.at)); - Plain MemoryFill; - ] ) - | MemoryCopy, Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' -> - let+ oob_s = mem_oob module_reg frame (0l @@ e.at) s n - and+ oob_d = mem_oob module_reg frame (0l @@ e.at) d n in - if oob_s || oob_d then - (vs', [Trapping (memory_error e.at Memory.Bounds) @@ e.at]) - else if n = 0l then (vs', []) - else if I32.le_u d s then - ( vs', - List.map - (at e.at) - [ - Plain (Const (I32 d @@ e.at)); - Plain (Const (I32 s @@ e.at)); - Plain - (Load - { - ty = I32Type; - align = 0; - offset = 0l; - pack = Some (Pack8, ZX); - }); - Plain - (Store - { - ty = I32Type; - align = 0; - offset = 0l; - pack = Some Pack8; - }); - Plain (Const (I32 (I32.add d 1l) @@ e.at)); - Plain (Const (I32 (I32.add s 1l) @@ e.at)); - Plain (Const (I32 (I32.sub n 1l) @@ e.at)); - Plain MemoryCopy; - ] ) - else - (* d > s *) - ( vs', - List.map - (at e.at) - [ - Plain (Const (I32 (I32.add d 1l) @@ e.at)); - Plain (Const (I32 (I32.add s 1l) @@ e.at)); - Plain (Const (I32 (I32.sub n 1l) @@ e.at)); - Plain MemoryCopy; - Plain (Const (I32 d @@ e.at)); - Plain (Const (I32 s @@ e.at)); - Plain - (Load - { - ty = I32Type; - align = 0; - offset = 0l; - pack = Some (Pack8, ZX); - }); - Plain - (Store - { - ty = I32Type; - align = 0; - offset = 0l; - pack = Some Pack8; - }); - ] ) - | MemoryInit x, Num (I32 n) :: Num (I32 s) :: Num (I32 d) :: vs' -> - let* mem_oob = mem_oob module_reg frame (0l @@ e.at) d n in - let* data_oob = data_oob module_reg frame x s n in - if mem_oob || data_oob then + let* block = Vector.get b inst.allocations.blocks in + let length = Vector.num_elements block in + if i = length then Lwt.return - (vs', [Trapping (memory_error e.at Memory.Bounds) @@ e.at]) - else if n = 0l then Lwt.return (vs', []) + (LS_Modify_top + (Label_stack ({label with label_code = (vs, es)}, stack))) else - let* inst = resolve_module_ref module_reg frame.inst in - let* seg = data inst x in - let* seg = Ast.get_data !seg inst.allocations.datas in - let+ b = Chunked_byte_vector.load_byte seg (Int64.of_int32 s) in - let b = Int32.of_int b in - ( vs', - List.map - (at e.at) - [ - Plain (Const (I32 d @@ e.at)); - Plain (Const (I32 b @@ e.at)); - Plain - (Store - { - ty = I32Type; - align = 0; - offset = 0l; - pack = Some Pack8; - }); - Plain (Const (I32 (I32.add d 1l) @@ e.at)); - Plain (Const (I32 (I32.add s 1l) @@ e.at)); - Plain (Const (I32 (I32.sub n 1l) @@ e.at)); - Plain (MemoryInit x); - ] ) - | DataDrop x, vs -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ seg = data inst x in - seg := Data_label 0l ; - (vs, []) - | RefNull t, vs' -> Lwt.return (Ref (NullRef t) :: vs', []) - | RefIsNull, Ref r :: vs' -> - Lwt.return - (match r with - | NullRef _ -> (Num (I32 1l) :: vs', []) - | _ -> (Num (I32 0l) :: vs', [])) - | RefFunc x, vs' -> - let* inst = resolve_module_ref module_reg frame.inst in - let+ f = func inst x in - (Ref (FuncRef f) :: vs', []) - | Const n, vs -> Lwt.return (Num n.it :: vs, []) - | Test testop, Num n :: vs' -> - Lwt.return - (try (value_of_bool (Eval_num.eval_testop testop n) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | Compare relop, Num n2 :: Num n1 :: vs' -> - Lwt.return - (try (value_of_bool (Eval_num.eval_relop relop n1 n2) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | Unary unop, Num n :: vs' -> - Lwt.return - (try (Num (Eval_num.eval_unop unop n) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | Binary binop, Num n2 :: Num n1 :: vs' -> - Lwt.return - (try (Num (Eval_num.eval_binop binop n1 n2) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | Convert cvtop, Num n :: vs' -> - Lwt.return - (try (Num (Eval_num.eval_cvtop cvtop n) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecConst v, vs -> Lwt.return (Vec v.it :: vs, []) - | VecTest testop, Vec n :: vs' -> - Lwt.return - (try (value_of_bool (Eval_vec.eval_testop testop n) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecUnary unop, Vec n :: vs' -> - Lwt.return - (try (Vec (Eval_vec.eval_unop unop n) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecBinary binop, Vec n2 :: Vec n1 :: vs' -> - Lwt.return - (try (Vec (Eval_vec.eval_binop binop n1 n2) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecCompare relop, Vec n2 :: Vec n1 :: vs' -> - Lwt.return - (try (Vec (Eval_vec.eval_relop relop n1 n2) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecConvert cvtop, Vec n :: vs' -> - Lwt.return - (try (Vec (Eval_vec.eval_cvtop cvtop n) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecShift shiftop, Num s :: Vec v :: vs' -> + let+ instr = Vector.get i block in + LS_Modify_top + (Label_stack + ( { + label with + label_code = + ( vs, + Vector.prepend_list + [ + Plain instr.it @@ instr.at; + From_block (Block_label b, Int32.succ i) @@ e.at; + ] + es ); + }, + stack )) + | Refer r -> Lwt.return - (try (Vec (Eval_vec.eval_shiftop shiftop v s) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecBitmask bitmaskop, Vec v :: vs' -> - Lwt.return - (try (Num (Eval_vec.eval_bitmaskop bitmaskop v) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecTestBits vtestop, Vec n :: vs' -> - Lwt.return - (try (value_of_bool (Eval_vec.eval_vtestop vtestop n) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecUnaryBits vunop, Vec n :: vs' -> - Lwt.return - (try (Vec (Eval_vec.eval_vunop vunop n) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecBinaryBits vbinop, Vec n2 :: Vec n1 :: vs' -> - Lwt.return - (try (Vec (Eval_vec.eval_vbinop vbinop n1 n2) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecTernaryBits vternop, Vec v3 :: Vec v2 :: Vec v1 :: vs' -> - Lwt.return - (try (Vec (Eval_vec.eval_vternop vternop v1 v2 v3) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecSplat splatop, Num n :: vs' -> - Lwt.return - (try (Vec (Eval_vec.eval_splatop splatop n) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecExtract extractop, Vec v :: vs' -> - Lwt.return - (try (Num (Eval_vec.eval_extractop extractop v) :: vs', []) - with exn -> (vs', [Trapping (numeric_error e.at exn) @@ e.at])) - | VecReplace replaceop, Num r :: Vec v :: vs' -> + (LS_Modify_top + (Label_stack + ( {label with label_code = (Vector.cons (Ref r) vs, es)}, + stack ))) + | Trapping msg -> + Lwt.return (LS_Modify_top (Label_trapped (msg @@ e.at))) + | Returning vs0 -> Lwt.return (LS_Modify_top (Label_result vs0)) + | Breaking (0l, vs0) -> + let vs0 = vmtake label.label_arity vs0 in + if Vector.num_elements stack = 0l then + Lwt.return (LS_Modify_top (Label_result vs0)) + else + let+ label', stack = Vector.pop stack in + let vs, es = label'.label_code in + LS_Consolidate_top + ( label', + concat_kont vs0 vs, + Vector.prepend_list + (List.map plain (Option.to_list label.label_break)) + es, + stack ) + | Breaking (k, vs0) -> + if Vector.num_elements stack = 0l then + Crash.error e.at "undefined label" ; + let+ label', stack = Vector.pop stack in + let vs', es' = label'.label_code in + LS_Modify_top + (Label_stack + ( { + label' with + label_code = + ( vs', + Vector.cons (Breaking (Int32.pred k, vs0) @@ e.at) es' + ); + }, + stack )) + | Invoke func -> Lwt.return - (try (Vec (Eval_vec.eval_replaceop replaceop v r) :: vs', []) - with exn -> (vs', [Trapping (numeric_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_value (List.rev vs)) - in - Crash.error - e.at - ("missing or ill-typed operand on stack (" ^ s1 ^ " : " ^ s2 ^ ")") - ) - | Refer r, vs -> Lwt.return (Ref r :: vs, []) - | Trapping msg, _ -> Trap.error e.at msg - | Returning _, _ -> Crash.error e.at "undefined frame" - | Breaking _, _ -> Crash.error e.at "undefined label" - | Label (_, _, (vs', [])), vs -> Lwt.return (vs' @ vs, []) - | Label (_, _, (_, {it = Trapping msg; at} :: _)), vs -> - Lwt.return (vs, [Trapping msg @@ at]) - | Label (_, _, (_, {it = Returning vs0; at} :: _)), vs -> - Lwt.return (vs, [Returning vs0 @@ at]) - | Label (n, es0, (_, {it = Breaking (0l, vs0); _} :: _)), vs -> - Lwt.return (take n vs0 e.at @ vs, List.map plain es0) - | Label (_, _, (_, {it = Breaking (k, vs0); at} :: _)), vs -> - Lwt.return (vs, [Breaking (Int32.sub k 1l, vs0) @@ at]) - | Label (n, es0, code'), vs -> - let+ c' = step module_reg {c with code = code'} in - (vs, [Label (n, es0, c'.code) @@ e.at]) - | Frame (_, _, (vs', [])), vs -> Lwt.return (vs' @ vs, []) - | Frame (_, _, (_, {it = Trapping msg; at} :: _)), vs -> - Lwt.return (vs, [Trapping msg @@ at]) - | Frame (n, _, (_, {it = Returning vs0; _} :: _)), vs -> - Lwt.return (take n vs0 e.at @ vs, []) - | Frame (n, frame', code'), vs -> - let+ c' = - step - module_reg - { - frame = frame'; - code = code'; - budget = c.budget - 1; - output = c.output; - input = c.input; - host_funcs = c.host_funcs; - } - in - (vs, [Frame (n, c'.frame, c'.code) @@ e.at]) - | Invoke _, _ when c.budget = 0 -> - Exhaustion.error e.at "call stack exhausted" - | Invoke func, vs -> ( - let (FuncType (ins, out)) = func_type_of func in - let n1, n2 = - (Instance.Vector.num_elements ins, Instance.Vector.num_elements out) - in - let args, vs' = (take n1 vs e.at, drop n1 vs e.at) in - match func with - | Func.AstFunc (_, inst', f) -> - (* TODO: https://gitlab.com/tezos/tezos/-/issues/3366 & - https://gitlab.com/tezos/tezos/-/issues/3082 - - This conversion to list can probably be avoided by using - Lazy_vector in the config for local variables. *) - let+ locals = Lazy_vector.Int32Vector.to_list f.it.locals in - let locals' = List.rev args @ List.map default_value locals in - let frame' = {inst = inst'; locals = List.map ref locals'} in - let instr' = - [ - Label (n2, [], ([], [From_block (f.it.body, 0l) @@ f.at])) - @@ f.at; - ] + (LS_Craft_frame + (Label_stack (label, stack), Inv_start {func; code = (vs, es)})) + else if Vector.num_elements stack = 0l then + Lwt.return (LS_Modify_top (Label_result vs)) + else + let+ label', stack = Vector.pop stack in + let vs', es' = label'.label_code in + LS_Consolidate_top (label', concat_kont vs vs', es', stack) + | LS_Consolidate_top (label', tick, es', stack) when concat_completed tick -> + Lwt.return + (LS_Modify_top + (Label_stack ({label' with label_code = (tick.res, es')}, stack))) + | LS_Consolidate_top (label', tick, es', stack) -> + let+ tick = concat_step tick in + LS_Consolidate_top (label', tick, es', stack) + | LS_Craft_frame (Label_stack (label, stack), Inv_stop {code; fresh_frame}) -> + let label_kont = Label_stack ({label with label_code = code}, stack) in + Lwt.return + (match fresh_frame with + | Some frame_stack -> LS_Push_frame (label_kont, frame_stack) + | None -> LS_Modify_top label_kont) + | LS_Craft_frame (label, istep) -> + let+ istep = invoke_step module_reg c frame no_region istep in + LS_Craft_frame (label, istep) + +let frame_step module_reg c = function + | SK_Result _ | SK_Trapped _ -> assert false + | SK_Start (frame, stack) -> ( + match frame.frame_label_kont with + | Label_trapped msg -> Lwt.return (SK_Trapped msg) + | Label_result vs0 -> + if Vector.num_elements stack = 0l then + let vs0 = vmtake frame.frame_arity vs0 in + Lwt.return (SK_Result vs0) + else + let+ frame', stack = Vector.pop stack in + let label, lstack = + match frame'.frame_label_kont with + | Label_stack (label, lstack) -> (label, lstack) in - (vs', [Frame (n2, frame', ([], instr')) @@ e.at]) - | Func.HostFunc (_, global_name) -> - Lwt.catch - (fun () -> - let (Host_funcs.Host_func f) = - Host_funcs.lookup ~global_name c.host_funcs - in - let* inst = resolve_module_ref module_reg frame.inst in - let+ res = f c.input c.output inst.memories (List.rev args) in - (List.rev res @ vs', [])) - (function - | Crash (_, msg) -> Crash.error e.at msg | exn -> raise exn)) - in - {c with code = (vs', es' @ es)} - -let rec eval module_reg (c : config) : value stack Lwt.t = - match c.code with - | vs, [] -> Lwt.return vs - | _, {it = Trapping msg; at} :: _ -> Trap.error at msg - | _, _ -> + let vs, es = label.label_code in + SK_Consolidate_label_result + (frame', stack, label, concat_kont vs0 vs, es, lstack) + | Label_stack _ as label -> + Lwt.return (SK_Next (frame, stack, LS_Start label))) + | SK_Consolidate_label_result (frame', stack, label, tick, es, lstack) + when concat_completed tick -> + let label_kont = + Label_stack ({label with label_code = (tick.res, es)}, lstack) + in + Lwt.return (SK_Start ({frame' with frame_label_kont = label_kont}, stack)) + | SK_Consolidate_label_result (frame', stack, label, tick, es, lstack) -> + let+ tick = concat_step tick in + SK_Consolidate_label_result (frame', stack, label, tick, es, lstack) + | SK_Next (frame, stack, LS_Modify_top label_kont) -> + let frame = {frame with frame_label_kont = label_kont} in + Lwt.return (SK_Start (frame, stack)) + | SK_Next (frame, stack, LS_Push_frame (label_kont, frame')) -> + let stack_size = Int32.(succ (Vector.num_elements stack) |> to_int) in + if c.stack_size_limit <= stack_size then + Exhaustion.error no_region "call stack exhausted" ; + let frame = {frame with frame_label_kont = label_kont} in + Lwt.return (SK_Start (frame', Vector.cons frame stack)) + | SK_Next (frame, stack, istep) -> + let+ istep = label_step module_reg c frame.frame_specs istep in + SK_Next (frame, stack, istep) + +let step module_reg c = + match c.step_kont with + | SK_Result _ | SK_Trapped _ -> assert false + | kont -> + let+ step_kont = frame_step module_reg c kont in + {c with step_kont} + +let rec eval module_reg (c : config) : value list Lwt.t = + match c.step_kont with + | SK_Result vs -> Vector.to_list vs + | SK_Trapped {it = msg; at} -> Trap.error at msg + | _ -> let* c = step module_reg c in eval module_reg c @@ -879,7 +1389,7 @@ let invoke ~module_reg ~caller ?(input = Input_buffer.alloc ()) ?(output = Output_buffer.alloc ()) host_funcs (func : func_inst) (vs : value list) : value list Lwt.t = let at = match func with Func.AstFunc (_, _, f) -> f.at | _ -> no_region in - let (FuncType (ins, _out)) = Func.type_of func in + let (FuncType (ins, out)) = Func.type_of func in let* ins_l = Lazy_vector.Int32Vector.to_list ins in if List.length vs <> (Lazy_vector.Int32Vector.num_elements ins |> Int32.to_int) then Crash.error at "wrong number of arguments" ; @@ -893,8 +1403,16 @@ let invoke ~module_reg ~caller ?(input = Input_buffer.alloc ()) | Func.AstFunc (_, inst, _) -> inst | Func.HostFunc (_, _) -> caller in + let n = Vector.num_elements out in let c = - config ~input ~output host_funcs inst (List.rev vs) [Invoke func @@ at] + config + ~input + ~output + host_funcs + ~frame_arity:n + inst + (Vector.of_list (List.rev vs)) + (Vector.singleton (Invoke func @@ at)) in Lwt.catch (fun () -> @@ -908,17 +1426,22 @@ type eval_const_kont = EC_Next of config | EC_Stop of value let eval_const_kont inst (const : const) = let c = - config (Host_funcs.empty ()) inst [] [From_block (const.it, 0l) @@ const.at] + config + (Host_funcs.empty ()) + inst + (Vector.empty ()) + (Vector.singleton (From_block (const.it, 0l) @@ const.at)) in EC_Next c let eval_const_completed = function EC_Stop v -> Some v | _ -> None let eval_const_step module_reg = function - | EC_Next {code = vs, []; _} -> ( - match vs with - | [v] -> Lwt.return (EC_Stop v) - | _ -> Crash.error Source.no_region "wrong number of results on stack") + | EC_Next {step_kont = SK_Result vs; _} -> + if Vector.num_elements vs = 1l then + let+ v, _ = Vector.pop vs in + EC_Stop v + else Crash.error Source.no_region "wrong number of results on stack" | EC_Next c -> let+ c = step module_reg c in EC_Next c @@ -1070,64 +1593,6 @@ let fold_right2_step {acc; lv; rv; offset} f = let+ acc = f x y acc in {acc; lv; rv; offset = Int32.pred offset} -type ('a, 'b) map_kont = { - origin : 'a Vector.t; - destination : 'b Vector.t; - offset : int32; -} - -let map_kont v = - {origin = v; destination = Vector.create (Vector.num_elements v); offset = 0l} - -let map_completed {origin; offset; _} = offset = Vector.num_elements origin - -let map_step {origin; destination; offset} f = - let open Lwt.Syntax in - let+ x = Vector.get offset origin in - let destination = Vector.set offset (f x) destination in - {origin; destination; offset = Int32.succ offset} - -let map_i_step {origin; destination; offset} f = - let open Lwt.Syntax in - let+ x = Vector.get offset origin in - let destination = Vector.set offset (f offset x) destination in - {origin; destination; offset = Int32.succ offset} - -let map_i_s_step {origin; destination; offset} f = - let open Lwt.Syntax in - let* x = Vector.get offset origin in - let+ y = f offset x in - let destination = Vector.set offset y destination in - {origin; destination; offset = Int32.succ offset} - -type 'a concat_kont = { - lv : 'a Vector.t; - rv : 'a Vector.t; - res : 'a Vector.t; - offset : int32; -} - -let concat_kont lv rv = - let lv_len = Vector.num_elements lv in - let rv_len = Vector.num_elements rv in - let len = Int32.(add lv_len rv_len) in - if Int32.(unsigned_compare len lv_len < 0 || unsigned_compare len rv_len < 0) - then raise Lazy_vector.SizeOverflow - else {lv; rv; res = Vector.create len; offset = 0l} - -let concat_step {lv; rv; res; offset} = - let lv_len = Vector.num_elements lv in - let+ x = - if offset < lv_len then Vector.get offset lv - else Vector.get Int32.(sub offset lv_len) rv - in - {lv; rv; res = Vector.set offset x res; offset = Int32.succ offset} - -let concat_completed {lv; rv; offset; _} = - let lv_len = Vector.num_elements lv in - let rv_len = Vector.num_elements rv in - Int32.add lv_len rv_len <= offset - type ('a, 'b) fold_left_kont = {origin : 'a Vector.t; acc : 'b; offset : int32} let fold_left_kont origin acc = {origin; acc; offset = 0l} @@ -1475,19 +1940,16 @@ let init_step ~module_reg ~self host_funcs (m : module_) (exts : extern list) = | IK_Join_admin (inst0, tick) -> ( match join_completed tick with | Some res -> - (* TODO: https://gitlab.com/tezos/tezos/-/issues/3076 - [config] should use lazy vector, not lists *) - let+ res = Vector.to_list res in - IK_Eval (inst0, config host_funcs self [] res) + Lwt.return + (IK_Eval (inst0, config host_funcs self (Vector.empty ()) res)) | None -> let+ tick = join_step tick in IK_Join_admin (inst0, tick)) - | IK_Eval (inst, {code = _, []; _}) -> + | IK_Eval (inst, {step_kont = SK_Result _; _}) -> (* No more admin instr, which means that we have returned from the _start function. *) Lwt.return (IK_Stop inst) - | IK_Eval (_, {code = _, {it = Trapping msg; at} :: _; _}) -> - Trap.error at msg + | IK_Eval (_, {step_kont = SK_Trapped {it = msg; at}; _}) -> Trap.error at msg | IK_Eval (inst, config) -> let+ config = step module_reg config in IK_Eval (inst, config) diff --git a/src/lib_webassembly/exec/eval.mli b/src/lib_webassembly/exec/eval.mli index 27b3b329144f7554e48694c0b20381c10f46a1ba..ca07ce410dcb51ab24c5d58614f3e47a4124ce38 100644 --- a/src/lib_webassembly/exec/eval.mli +++ b/src/lib_webassembly/exec/eval.mli @@ -1,6 +1,21 @@ open Values open Instance +(* Kontinuation *) + +type ('a, 'b) map_kont = { + origin : 'a Vector.t; + destination : 'b Vector.t; + offset : int32; +} + +type 'a concat_kont = { + lv : 'a Vector.t; + rv : 'a Vector.t; + res : 'a Vector.t; + offset : int32; +} + exception Link of Source.region * string exception Trap of Source.region * string @@ -21,11 +36,9 @@ type init_state = initialization. *) exception Init_step_error of init_state -type frame = {inst : module_key; locals : value ref list} - -type code = value list * admin_instr list +type frame = {inst : module_key; locals : value ref Vector.t} -and admin_instr = admin_instr' Source.phrase +type admin_instr = admin_instr' Source.phrase and admin_instr' = | From_block of Ast.block_label * int32 @@ -33,18 +46,92 @@ and admin_instr' = | Refer of ref_ | Invoke of func_inst | Trapping of string - | Returning of value list - | Breaking of int32 * value list - | Label of int32 * Ast.instr list * code - | Frame of int32 * frame * code + | Returning of value Vector.t + | Breaking of int32 * value Vector.t + +type code = value Vector.t * admin_instr Vector.t + +type label = { + label_arity : int32 option; + label_frame_specs : frame; + label_break : Ast.instr option; + label_code : code; +} + +type ongoing = Ongoing_kind + +type finished = Finished_kind + +type _ label_kont = + | Label_stack : label * label Vector.t -> ongoing label_kont + | Label_result : value Vector.t -> finished label_kont + | Label_trapped : string Source.phrase -> finished label_kont + +type 'a frame_stack = { + frame_arity : int32 option; + frame_specs : frame; + frame_label_kont : 'a label_kont; +} + +type invoke_step_kont = + | Inv_start of {func : func_inst; code : code} + | Inv_prepare_locals of { + arity : int32; + args : value Vector.t; + vs : value Vector.t; + instructions : admin_instr Vector.t; + inst : module_key; + func : Ast.func; + locals_kont : (Types.value_type, value ref) map_kont; + } + | Inv_prepare_args of { + arity : int32; + vs : value Vector.t; + instructions : admin_instr Vector.t; + inst : module_key; + func : Ast.func; + locals : value ref Vector.t; + args_kont : (value, value ref) map_kont; + } + | Inv_concat of { + arity : int32; + vs : value Vector.t; + instructions : admin_instr Vector.t; + inst : module_key; + func : Ast.func; + concat_kont : value ref concat_kont; + } + | Inv_stop of {code : code; fresh_frame : ongoing frame_stack option} + +type label_step_kont = + | LS_Start : ongoing label_kont -> label_step_kont + | LS_Craft_frame of ongoing label_kont * invoke_step_kont + | LS_Push_frame of ongoing label_kont * ongoing frame_stack + | LS_Consolidate_top of + label * value concat_kont * admin_instr Vector.t * label Vector.t + | LS_Modify_top : 'a label_kont -> label_step_kont + +type step_kont = + | SK_Start : 'a frame_stack * ongoing frame_stack Vector.t -> step_kont + | SK_Next : + 'a frame_stack * ongoing frame_stack Vector.t * label_step_kont + -> step_kont + | SK_Consolidate_label_result of + ongoing frame_stack + * ongoing frame_stack Vector.t + * label + * value concat_kont + * admin_instr Vector.t + * label Vector.t + | SK_Result of value Vector.t + | SK_Trapped of string Source.phrase type config = { - frame : frame; input : input_inst; output : output_inst; - code : code; + step_kont : step_kont; host_funcs : Host_funcs.registry; - budget : int; (* to model stack overflow *) + stack_size_limit : int; } type ('a, 'b, 'acc) fold_right2_kont = { @@ -54,19 +141,6 @@ type ('a, 'b, 'acc) fold_right2_kont = { offset : int32; } -type ('a, 'b) map_kont = { - origin : 'a Vector.t; - destination : 'b Vector.t; - offset : int32; -} - -type 'a concat_kont = { - lv : 'a Vector.t; - rv : 'a Vector.t; - res : 'a Vector.t; - offset : int32; -} - type ('a, 'b) fold_left_kont = {origin : 'a Vector.t; acc : 'b; offset : int32} type eval_const_kont = EC_Next of config | EC_Stop of value @@ -163,7 +237,8 @@ val config : ?input:input_inst -> ?output:output_inst -> Host_funcs.registry -> + ?frame_arity:int32 (* The number of values returned by the computation *) -> module_key -> - value list -> - admin_instr list -> + value Vector.t -> + admin_instr Vector.t -> config diff --git a/src/proto_alpha/lib_protocol/test/integration/test_sc_rollup_wasm.ml b/src/proto_alpha/lib_protocol/test/integration/test_sc_rollup_wasm.ml index ff1162c9fae76b590fbca1de7e42572003c92257..f5250f88aa3b4f15a200fd3d70c63048b529b282 100644 --- a/src/proto_alpha/lib_protocol/test/integration/test_sc_rollup_wasm.ml +++ b/src/proto_alpha/lib_protocol/test/integration/test_sc_rollup_wasm.ml @@ -124,7 +124,7 @@ module Prover = Alpha_context.Sc_rollup.Wasm_2_0_0PVM.Make (WASM_P) pass. It should be updated to [16 * 1024] once the small ticks milestone is completed. *) -let proof_size_limit = 28_116 +let proof_size_limit = 21_488 let check_proof_size ~loc context input_opt s = let open Lwt_result_syntax in diff --git a/tezt/tests/expected/sc_rollup.ml/Alpha- wasm_2_0_0 - runs with kernel - computation.out b/tezt/tests/expected/sc_rollup.ml/Alpha- wasm_2_0_0 - runs with kernel - computation.out deleted file mode 100644 index d549d08ad956ccce5f1257dc0290f622b1060982..0000000000000000000000000000000000000000 --- a/tezt/tests/expected/sc_rollup.ml/Alpha- wasm_2_0_0 - runs with kernel - computation.out +++ /dev/null @@ -1,602 +0,0 @@ - -./tezos-client --wait none originate sc rollup from bootstrap1 of kind wasm_2_0_0 of type string booting with 00000026870061736d01000000014a0c60027f7f017f60027f7f0060037f7f7f017f60000060017f0060037f7f7f0060047f7f7f7f017f60047f7f7f7f0060017f017f60057f7f7f7f7f017f60017f017e60057f7f7f7f7f00034746030400050601000506040700080902070407000803080404040507010a0a0004050008010104010101010b010200000101010301010004020501020a0000080808000b00020204050170011d1d05030100110619037f01418080c0000b7f0041948cc0000b7f0041a08cc0000b073304066d656d6f727902000b6b65726e656c5f6e65787400000a5f5f646174615f656e6403010b5f5f686561705f6261736503020922010041010b1c013c090a0b0c1112131023171c161d18262728292c2d2e35413d363b0afa4646860201057f23808080800041106b22002480808080001094808080000240024041002802e083c080000d004100417f3602e083c080000240024041002802e483c080002201450d00200128020041016a210241002802ec83c08000210341002802e883c0800021040c010b410441041082808080002201450d0241002104410020013602e483c080002001410036020041012102410121030b20012002360200410020033602e883c080004100200420036a3602ec83c08000410041002802e083c0800041016a3602e083c08000200041106a2480808080000f0b41b480c080004110200041086a41c480c0800041a480c0800010c280808000000b4104410410b180808000000b02000b1301017f20002001108680808000210220020f0b0f002000200120021087808080000f0b1701017f2000200120022003108880808000210420040f0b0d002000200110b4808080000f0b120041f083c0800020002001108e808080000b140041f083c08000200020012002108f808080000b4501017f024041f083c0800020032002108e808080002204450d002004200020032001200120034b1b10c5808080001a41f083c08000200020012002108f808080000b20040b02000b7701017f02400240200241027422022003410374418080016a2203200220034b1b418780046a220441107640002203417f470d0041012102410021030c010b20034110742203420037030041002102200341003602082003200320044180807c716a4102723602000b20002003360204200020023602000b05004180040b040041010bef0401087f024020022802002205450d002001417f6a210620004102742107410020016b21080340200541086a2109024002402005280208220a4101710d00200521010c010b03402009200a417e71360200024002402005280204220a417c7122090d00410021010c010b4100200920092d00004101711b21010b02402005280200220b417c71220c450d004100200c200b4102711b220b450d00200b200b2802044103712009723602042005280204220a417c7121090b02402009450d00200920092802004103712005280200417c71723602002005280204210a0b2005200a41037136020420052005280200220941037136020002402009410271450d00200120012802004102723602000b20022001360200200141086a2109200121052001280208220a4101710d000b0b02402001280200417c71220a200141086a22056b2007490d00024002402005200320002004280210118080808000004102746a41086a200a20076b200871220a4d0d0020062005710d0220022009280200417c7136020020012001280200410172360200200121050c010b200a4100360200200a41786a2205420037020020052001280200417c7136020002402001280200220a417c71220b450d004100200b200a4102711b220a450d00200a200a2802044103712005723602040b2005200528020441037120017236020420092009280200417e71360200200120012802002209410371200572220a3602000240024020094102710d00200528020021010c010b2001200a417d713602002005200528020041027222013602000b200520014101723602000b200541086a0f0b20022001280208220536020020050d000b0b41000bac0301037f23808080800041106b22032480808080000240024020010d00200221010c010b200141036a220441027621050240200241054f0d002005417f6a220141ff014b0d00200320003602082003200020014102746a41046a41002001418002491b220028020036020c0240200520022003410c6a200341086a41ec80c08000108d8080800022010d002003200341086a200520021091808080004100210120032802000d0020032802042201200328020c3602082003200136020c200520022003410c6a200341086a41ec80c08000108d8080800021010b2000200328020c3602000c010b2003200028020036020c0240200520022003410c6a41d480c0800041d480c08000108d8080800022010d0002402004417c7122012002410374418080016a2204200120044b1b418780046a220441107640002201417f470d00410021010c010b20014110742201200328020c360208200141003602042001200120044180807c716a4102723602002003200136020c200520022003410c6a41d480c0800041d480c08000108d8080800021010b2000200328020c3602000b200341106a24808080800020010be60501067f23808080800041106b220424808080800002402001450d002002450d000240200341054f0d00200241036a410276417f6a220341ff014b0d0020014100360200200141786a22022002280200417e713602002004200036020c200020034102746a41046a22002802002103024002402004410c6a109380808000450d00024002402001417c6a2205280200417c712206450d00200628020022074101710d0002400240024020022802002208417c7122010d00200621090c010b200621094100200120084102711b2208450d002008200828020441037120067236020420052802002201417c712209450d012002280200417c712101200928020021070b20092001200741037172360200200528020021010b200520014103713602002002200228020022014103713602002001410271450d01200620062802004102723602000c010b20022802002206417c712205450d014100200520064102711b2206450d0120062d00004101710d0120012006280208417c71360200200620024101723602080b200321020c010b200120033602000b200020023602000c010b20014100360200200141786a220220022802002203417e71360200200028020021050240024002402001417c6a2207280200417c712206450d00200628020022094101710d000240024002402003417c7122010d00200621080c010b200621084100200120034102711b2203450d002003200328020441037120067236020420072802002201417c712208450d012002280200417c712101200828020021090b20082001200941037172360200200728020021010b200720014103713602002002200228020022014103713602002001410271450d01200620062802004102723602000c010b2003417c712206450d014100200620034102711b2203450d0120032d00004101710d0120012003280208417c71360200200320024101723602080b200020053602000c010b20012005360200200020023602000b200441106a2480808080000b02000b960201027f23808080800041106b220424808080800020042001280200220528020036020c024002400240200241026a220220026c220241801020024180104b1b220141042004410c6a418481c08000418481c08000108d808080002202450d002005200428020c3602000c010b2004418481c0800020014104108a80808000024002402004280200450d002005200428020c3602000c010b20042802042202200428020c3602082004200236020c200141042004410c6a418481c08000418481c08000108d8080800021022005200428020c36020020020d010b410121010c010b200242003702042002200220014102746a410272360200410021010b2000200236020420002001360200200441106a2480808080000b040020010b040041000b02000b040000000b02000b2a01017f0240200041046a2802002201450d0020002802002200450d002000200141011083808080000b0b2a01017f024020002802042201450d00200041086a2802002200450d002001200041011083808080000b0bdb0101027f23808080800041206b22032480808080000240200120026a22022001490d00200041046a280200220441017422012002200120024b1b22014108200141084b1b2101024002402004450d00200341106a41086a410136020020032004360214200320002802003602100c010b200341003602100b200320014101200341106a109a8080800002402003280200450d00200341086a2802002200450d012003280204200010b180808000000b20032802042102200041046a200136020020002002360200200341206a2480808080000f0b10b280808000000bb50101027f0240024002400240024002400240024002402002450d004101210420014100480d0120032802002205450d02200328020422030d0520010d03200221030c040b20002001360204410121040b410021010c060b20010d00200221030c010b2001200210828080800021030b2003450d010c020b200520032002200110848080800022030d010b20002001360204200221010c010b20002003360204410021040b20002004360200200041086a20013602000bdb0101037f23808080800041206b22022480808080000240200141016a22032001490d00200041046a280200220441017422012003200120034b1b22014108200141084b1b2101024002402004450d00200241106a41086a410136020020022004360214200220002802003602100c010b200241003602100b200220014101200241106a109a8080800002402002280200450d00200241086a2802002200450d012002280204200010b180808000000b20022802042103200041046a200136020020002003360200200241206a2480808080000f0b10b280808000000b0c0042f6e2f8b1f2e1afe7050b0d0042d1ae98c49983b2f7847f0bf70201037f23808080800041106b220224808080800002400240024002402001418001490d002002410036020c20014180104f0d0120022001413f71418001723a000d2002200141067641c001723a000c410221010c020b024020002802082203200041046a280200470d0020002003109b80808000200028020821030b2000200341016a360208200028020020036a20013a00000c020b0240200141808004490d0020022001413f71418001723a000f2002200141127641f001723a000c20022001410676413f71418001723a000e20022001410c76413f71418001723a000d410421010c010b20022001413f71418001723a000e20022001410c7641e001723a000c20022001410676413f71418001723a000d410321010b0240200041046a280200200041086a220428020022036b20014f0d00200020032001109980808000200428020021030b200028020020036a2002410c6a200110c5808080001a2004200320016a3602000b200241106a24808080800041000b180020002802002000280204200028020810a080808000000bbf0101027f23808080800041106b2203248080808000200041146a28020021040240024002400240200041046a2802000e020001030b20040d02419c81c080002100410021040c010b20040d01200028020022002802042104200028020021000b2003200436020420032000360200200341b882c08000200110be808080002002200110c08080800010aa80808000000b2003410036020420032000360200200341a482c08000200110be808080002002200110c08080800010aa80808000000b1c00024020000d00419c81c08000412b200110b880808000000b20000b2000024020000d00419c81c08000412b41f481c0800010b880808000000b20000b02000b2501017f2000200141002802f48bc080002202418b8080800020021b1181808080000000000b5901037f23808080800041106b2201248080808000200010bf8080800041e481c0800010a1808080002102200010be8080800010a28080800021032001200236020820012000360204200120033602002001109f80808000000bb10202047f017e23808080800041306b2202248080808000200141046a2103024020012802040d0020012802002104200241086a41086a22054100360200200242013703082002200241086a360214200241186a41106a200441106a290200370300200241186a41086a200441086a29020037030020022004290200370318200241146a41cc82c08000200241186a10ba808080001a200341086a2005280200360200200320022903083702000b200241186a41086a2204200341086a2802003602002001410c6a41003602002003290200210620014201370204200220063703180240410c410410828080800022010d00410c410410b180808000000b20012002290318370200200141086a20042802003602002000418482c0800036020420002001360200200241306a2480808080000bc80101037f23808080800041306b2202248080808000200141046a2103024020012802040d0020012802002101200241086a41086a22044100360200200242013703082002200241086a360214200241186a41106a200141106a290200370300200241186a41086a200141086a29020037030020022001290200370318200241146a41cc82c08000200241186a10ba808080001a200341086a2004280200360200200320022903083702000b2000418482c0800036020420002003360200200241306a2480808080000b4e01027f200128020421022001280200210302404108410410828080800022010d004108410410b180808000000b20012002360204200120033602002000419482c08000360204200020013602000b14002000419482c08000360204200020013602000bab0201037f23808080800041206b220524808080800041012106410041002802848cc08000220741016a3602848cc080000240024041002d00888cc08000450d0041002802908cc0800041016a21060c010b410041013a00888cc080000b410020063602908cc080000240024020074100480d00200641024b0d00200520043a0018200520033602142005200236021041002802f88bc080002207417f4c0d004100200741016a22073602f88bc08000024041002802808cc080002202450d0041002802fc8bc08000210720052000200128021011818080800000200520052903003703082007200541086a20022802141181808080000041002802f88bc0800021070b41002007417f6a3602f88bc08000200641014b0d0020040d010b00000b2000200110ab80808000000b3101017f23808080800041106b22022480808080002002200136020c20022000360208200241086a1095808080001a00000b5801027f02402000280200220341046a280200200341086a220428020022006b20024f0d00200320002002109980808000200428020021000b200328020020006a2001200210c5808080001a2004200020026a36020041000b120020002802002001109e808080001a41000b7401017f23808080800041206b220224808080800020022000280200360204200241086a41106a200141106a290200370300200241086a41086a200141086a29020037030020022001290200370308200241046a41cc82c08000200241086a10ba808080002101200241206a24808080800020010b0d002000200110b080808000000b0d0020002001108580808000000b0d002000200110b380808000000b4e01017f23808080800041206b22002480808080002000411c6a41003602002000418083c080003602182000420137020c2000419483c08000360208200041086a419c83c0800010b980808000000b0d002000200110af80808000000b0d002000200110a480808000000b0d0020002802001a037f0c000b0b02000bd80701067f20002802102103024002400240024002400240200028020822044101460d0020034101470d010b20034101470d03200120026a2105200041146a28020022060d0141002107200121080c020b2000280218200120022000411c6a28020028020c1182808080000021030c030b41002107200121080340200822032005460d020240024020032c00002208417f4c0d00200341016a21080c010b0240200841604f0d00200341026a21080c010b0240200841704f0d00200341036a21080c010b20032d0002413f7141067420032d0001413f71410c747220032d0003413f7172200841ff0171411274418080f0007172418080c400460d03200341046a21080b200720036b20086a21072006417f6a22060d000b0b20082005460d00024020082c00002203417f4a0d0020034160490d0020034170490d0020082d0002413f7141067420082d0001413f71410c747220082d0003413f7172200341ff0171411274418080f0007172418080c400460d010b02400240024020070d00410021080c010b024020072002490d00410021032002210820072002460d010c020b4100210320072108200120076a2c00004140480d010b20082107200121030b2007200220031b21022003200120031b21010b024020040d002000280218200120022000411c6a28020028020c118280808000000f0b2000410c6a28020021050240024020024110490d002001200210c38080800021080c010b024020020d00410021080c010b20024103712107024002402002417f6a41034f0d0041002108200121030c010b2002417c71210641002108200121030340200820032c000041bf7f4a6a200341016a2c000041bf7f4a6a200341026a2c000041bf7f4a6a200341036a2c000041bf7f4a6a2108200341046a21032006417c6a22060d000b0b2007450d000340200820032c000041bf7f4a6a2108200341016a21032007417f6a22070d000b0b0240200520084d0d0041002103200520086b22072106024002400240410020002d0020220820084103461b4103710e03020001020b41002106200721030c010b20074101762103200741016a41017621060b200341016a21032000411c6a28020021072000280204210820002802182100024003402003417f6a2203450d0120002008200728021011808080800000450d000b41010f0b410121032008418080c400460d01200020012002200728020c118280808000000d01410021030340024020062003470d0020062006490f0b200341016a210320002008200728021011808080800000450d000b2003417f6a2006490f0b2000280218200120022000411c6a28020028020c118280808000000f0b20030b5401017f23808080800041206b2203248080808000200341146a4100360200200341ac83c08000360210200342013702042003200136021c200320003602182003200341186a3602002003200210b980808000000b4c01017f23808080800041206b2202248080808000200241013a00182002200136021420022000360210200241bc83c0800036020c200241ac83c08000360208200241086a10a580808000000bbd05010a7f23808080800041306b2203248080808000200341246a2001360200200341033a0028200342808080808004370308200320003602204100210420034100360218200341003602100240024002400240200228020822050d00200241146a2802002206450d0120022802002101200228021021002006417f6a41ffffffff017141016a2204210603400240200141046a2802002207450d00200328022020012802002007200328022428020c118280808000000d040b2000280200200341086a200041046a280200118080808000000d03200041086a2100200141086a21012006417f6a22060d000c020b0b2002410c6a2802002200450d00200041057421082000417f6a41ffffff3f7141016a2104200228020021014100210603400240200141046a2802002200450d00200328022020012802002000200328022428020c118280808000000d030b2003200520066a2200411c6a2d00003a00282003200041046a290200422089370308200041186a28020021092002280210210a4100210b41002107024002400240200041146a2802000e03010002010b2009410374210c41002107200a200c6a220c280204419880808000470d01200c28020028020021090b410121070b2003200936021420032007360210200041106a28020021070240024002402000410c6a2802000e03010002010b20074103742109200a20096a2209280204419880808000470d01200928020028020021070b4101210b0b2003200736021c2003200b360218200a20002802004103746a2200280200200341086a2000280204118080808000000d02200141086a21012008200641206a2206470d000b0b4100210020042002280204492201450d012003280220200228020020044103746a410020011b22012802002001280204200328022428020c11828080800000450d010b410121000b200341306a24808080800020000b0c004281b8aa93f5f3e5ec140b2100200128021841ac83c08000410e2001411c6a28020028020c118280808000000b140020012000280200200028020410b7808080000b070020002802080b0700200028020c0b070020002d00100b180020002802002001200028020428020c118080808000000b930101017f23808080800041c0006b22052480808080002005200136020c2005200036020820052003360214200520023602102005412c6a41023602002005413c6a4199808080003602002005420237021c200541d083c080003602182005419a808080003602342005200541306a3602282005200541106a3602382005200541086a360230200541186a200410b980808000000ba30801097f02400240200041036a417c71220220006b220320014b0d00200341044b0d00200120036b22044104490d0020044103712105410021064100210102402003450d00200341037121070240024020022000417f736a41034f0d0041002101200021020c010b2003417c71210841002101200021020340200120022c000041bf7f4a6a200241016a2c000041bf7f4a6a200241026a2c000041bf7f4a6a200241036a2c000041bf7f4a6a2101200241046a21022008417c6a22080d000b0b2007450d000340200120022c000041bf7f4a6a2101200241016a21022007417f6a22070d000b0b200020036a210002402005450d0020002004417c716a22022c000041bf7f4a210620054101460d00200620022c000141bf7f4a6a210620054102460d00200620022c000241bf7f4a6a21060b20044102762103200620016a21080340200021062003450d02200341c001200341c001491b220441037121052004410274210902400240200441fc0171220a41027422000d00410021020c010b200620006a2107410021022006210003402000410c6a2802002201417f73410776200141067672418182840871200041086a2802002201417f73410776200141067672418182840871200041046a2802002201417f7341077620014106767241818284087120002802002201417f7341077620014106767241818284087120026a6a6a6a2102200041106a22002007470d000b0b200620096a2100200320046b2103200241087641ff81fc0771200241ff81fc07716a418180046c41107620086a21082005450d000b2006200a4102746a2100200541ffffffff036a220441ffffffff0371220241016a2201410371210302400240200241034f0d00410021020c010b200141fcffffff077121014100210203402000410c6a2802002207417f73410776200741067672418182840871200041086a2802002207417f73410776200741067672418182840871200041046a2802002207417f7341077620074106767241818284087120002802002207417f7341077620074106767241818284087120026a6a6a6a2102200041106a21002001417c6a22010d000b0b02402003450d00200441818080807c6a2101034020002802002207417f7341077620074106767241818284087120026a2102200041046a21002001417f6a22010d000b0b200241087641ff81fc0771200241ff81fc07716a418180046c41107620086a0f0b024020010d0041000f0b20014103712102024002402001417f6a41034f0d00410021080c010b2001417c712101410021080340200820002c000041bf7f4a6a200041016a2c000041bf7f4a6a200041026a2c000041bf7f4a6a200041036a2c000041bf7f4a6a2108200041046a21002001417c6a22010d000b0b2002450d000340200820002c000041bf7f4a6a2108200041016a21002002417f6a22020d000b0b20080bc10201087f024002402002410f4b0d00200021030c010b2000410020006b41037122046a210502402004450d0020002103200121060340200320062d00003a0000200641016a2106200341016a22032005490d000b0b2005200220046b2207417c7122086a210302400240200120046a2209410371450d0020084101480d012009410374220641187121022009417c71220a41046a2101410020066b4118712104200a28020021060340200520062002762001280200220620047472360200200141046a2101200541046a22052003490d000c020b0b20084101480d0020092101034020052001280200360200200141046a2101200541046a22052003490d000b0b20074103712102200920086a21010b02402002450d00200320026a21050340200320012d00003a0000200141016a2101200341016a22032005490d000b0b20000b0e0020002001200210c4808080000b0bea030100418080c0000be0032f7573722f7372632f6b65726e656c5f656e7472792f7372632f63616368652e7273000000001000220000001300000020000000616c726561647920626f72726f776564010000000000000001000000020000000300000000000000010000000400000005000000060000000300000004000000040000000700000008000000090000000a000000000000000100000004000000050000000600000063616c6c656420604f7074696f6e3a3a756e77726170282960206f6e206120604e6f6e65602076616c75656c6962726172792f7374642f7372632f70616e69636b696e672e727300c70010001c000000460200001f000000c70010001c000000470200001e0000000c0000000c000000040000000d0000000e00000008000000040000000f00000010000000100000000400000011000000120000000e000000080000000400000013000000140000000e00000004000000040000001500000016000000170000006c6962726172792f616c6c6f632f7372632f7261775f7665632e72736361706163697479206f766572666c6f770000008001100011000000640110001c0000000602000005000000426f72726f774d75744572726f7200001b00000000000000010000001c0000003a200000ac01100000000000cc01100002000000 --burn-cap 9999999 -Node is bootstrapped. -Estimated gas: 3149.921 units (will add 100 for safety) -Estimated storage: 16523 bytes added (will add 20 for safety) -Operation successfully injected in the node. -Operation hash is '[OPERATION_HASH]' -NOT waiting for the operation to be included. -Use command - tezos-client wait for [OPERATION_HASH] to be included --confirmations 1 --branch [BLOCK_HASH] -and/or an external block explorer to make sure that it has been included. -This sequence of operations was run: - Manager signed operations: - From: [PUBLIC_KEY_HASH] - Fee to the baker: ꜩ0.010549 - Expected counter: 1 - Gas limit: 3250 - Storage limit: 16543 bytes - Balance updates: - [PUBLIC_KEY_HASH] ... -ꜩ0.010549 - payload fees(the block proposer) ....... +ꜩ0.010549 - Smart contract rollup origination: - Kind: wasm_2_0_0 - Parameter type: string - Boot sector: '&asmJ ```````````~`GF  - -  - pA A A 3memory kernel_next -__data_end __heap_base "A < - #&'(),-.5A=6; -FF#Ak"$@@A( AA6@@A("E (Aj!A(!A(!  AA"E A!A 6 A6A!A!  6A 6A  j6AA(Aj6 Aj$ AA AjAĀA€ AA   !        !   A  A   E@A  "E     KŀA     w@@ At" AtAj"  KAj"Av@"AG A!A!  At"B7A! A6   A|qjAr6 6 6 A A @ ("E Aj! At!A k!@ Aj! @@ (" -Aq !  @ -A~q6@@ (" -A|q" A!  A -Aq! @ (" A|q" E A Aq" E (Aq r6 (" -A|q! @ E (Aq (A|qr6 (! -  -Aq6  (" Aq6@ AqE  (Ar6  6 Aj! ! (" -Aq @ (A|q" - Aj"k I @@   (AtjAj - k q" -M  q   (A|q6  (Ar6 !  -A6 -Axj"B7  (A|q6@ (" -A|q" E A -Aq" -E - -(Aq r6  (Aq r6 (A~q6  (" Aq r" -6@@ Aq (!   -A}q6  (Ar"6  Ar6 Aj  ("6  A #Ak"$@@  !  Aj"Av!@ AO Aj"AK  6  AtjAjA AI"(6 @   A j AjA"  Aj  A! ( (" ( 6  6   A j AjA! ( 6   (6 @   A jAԀAԀ" @ A|q" AtAj"  KAj"Av@"AG A!  At" ( 6 A6   A|qjAr6  6   A jAԀAԀ! ( 6 Aj$  #Ak"$@ E E @ AO AjAvAj"AK A6 Axj" (A~q6  6 AtjAj"(!@@ A jE @@ A|j"(A|q"E ("Aq @@@ ("A|q" !  ! A  Aq"E  (Aq r6 ("A|q" E  (A|q! (!  Aqr6 (!  Aq6  ("Aq6 AqE   (Ar6  ("A|q"E A  Aq"E  -Aq   (A|q6  Ar6 !   6 6  A6 Axj" ("A~q6 (!@@@ A|j"(A|q"E (" Aq @@@ A|q" !  !A  Aq"E  (Aq r6 ("A|q"E  (A|q! (!   Aqr6 (!  Aq6  ("Aq6 AqE   (Ar6  A|q"E A  Aq"E  -Aq   (A|q6  Ar6 6   6 6 Aj$  #Ak"$  ("(6 @@@ Aj" l"A AK"A A jAA"E  ( 6  A A@@ (E  ( 6  (" ( 6  6 A A jAA!  ( 6   A!  B7   AtjAr6A! 6 6 Aj$   A    *@ Aj("E ("E A *@ ("E Aj("E  A #A k"$@  j" I Aj("At"   K"A AK!@@ E AjAjA6  6  (6  A6  A Aj@ (E Aj("E  (  (! Aj 6 6 A j$  @@@@@@@@@ E A! AH  ("E  ("    !  6A! A!   !   ! E      "  6 !  6A! 6 Aj 6 #A k"$@ Aj" I Aj("At"   K"A AK!@@ E AjAjA6  6  (6  A6  A Aj@ (E Aj("E  (  (! Aj 6 6 A j$  B BѮę #Ak"$@@@@ AI A6 AO   A?qAr:  AvAr: A!  @ (" Aj(G  (! Aj6 ( j :  @ AI  A?qAr:  AvAr:  AvA?qAr:  A vA?qAr: A!   A?qAr:  A vAr:  AvA?qAr: A! @ Aj( Aj"("k O   (! ( j A j ŀ   j6 Aj$A  ( ( ( #Ak"$ Aj(!@@@@ Aj(  A!A!    ("(! (!  6  6 A    A6  6 A    @ AA+  @ AA+A  % A("A  Y#Ak"$ A! !  6  6  6  ~#A0k"$ Aj!@ ( (! AjAj"A6 B7  Aj6 AjAj Aj)7 AjAj Aj)7  )7 Aj Aj Aj (6  )7 AjAj" Aj(6 A jA6 )! B7  7@A A" A A  )7 Aj (6 A6 6 A0j$ #A0k"$ Aj!@ ( (! AjAj"A6 B7  Aj6 AjAj Aj)7 AjAj Aj)7  )7 Aj Aj Aj (6  )7 A6 6 A0j$ N (! (!@AA" AA  6  6 A6 6  A6 6 #A k"$A!AA("Aj6@@A-E A(Aj!  AA: A 6@@ AH AK  :  6  6A("AL A Aj"6@A("E A(!  (  )7  Aj (A(! A Aj6 AK    1#Ak"$  6  6 Aj X@ ("Aj( Aj"("k O   (! ( j  ŀ  j6A  ( A t#A k"$  (6 AjAj Aj)7 AjAj Aj)7  )7 Aj Aj! A j$     N#A k"$ AjA6 A6 B7 A6 AjA   (   (!@@@@@@ ("AF AG  AG   j! Aj(" A! !  (   Aj(( !  A! !@ " F @@ ,"AL Aj!  @ A`O Aj!  @ ApO Aj!  -A?qAt -A?qA tr -A?qr AqAtAqrAF  Aj!  k j! Aj"  F @ ,"AJ A`I ApI -A?qAt -A?qA tr -A?qr AqAtAqrAF  @@@  A!  @  I A! !  F   A! !  j,A@H  ! !   !   ! @  (   Aj((  A j(!@@ AI  À!  @  A!  Aq!@@ AjAO A! !  A|q!A! !@  ,AJj Aj,AJj Aj,AJj Aj,AJj! Aj! A|j" E @  ,AJj! Aj! Aj" @  M A!  k"!@@@A - " AFAq A! !  Av! AjAv! Aj! Aj(! (! (!@@ Aj"E   (E A A! AF    (  A!@@  G  I Aj!  (E Aj I (   Aj((   T#A k"$ AjA6 A6 B7  6  6  Aj6   L#A k"$ A:  6  6 A6 A6 Aj  -#A0k"$ A$j 6 A:( B7  6 A! A6 A6@@@@ (" Aj("E  (! (! AjAqAj"!@@ Aj("E ( (  ($(   ( Aj Aj(  Aj! Aj! Aj"  A j("E At! AjA?qAj! (!A!@@ Aj("E ( ( ($(     j"Aj-:(  Aj)B 7 Aj(! (! -A! A!@@@ Aj( At! A! - j" (AG  ((! A!  6  6 Aj(!@@@ A j( At! - j" (AG  ((! A!  6  6 - (Atj"( Aj (  Aj!  A j"G A!  (I"E  ( ( AtjA "( ( ($( E  A! A0j$ B ! (AA Aj((    ( (  (  (  -  (  ((  #Ak"$  6  6  6  6 A,jA6 A