From d77103d46c556ba0ba8704fc2bf5ffaf06ee4ed0 Mon Sep 17 00:00:00 2001 From: Corneliu Hoffman Date: Tue, 16 Aug 2022 15:09:35 +0100 Subject: [PATCH 1/2] SCORU/WASM: write_output --- src/lib_scoru_wasm/host_funcs.ml | 89 +++++++-- src/lib_scoru_wasm/host_funcs.mli | 19 +- src/lib_scoru_wasm/test/ast_generators.ml | 41 +++- src/lib_scoru_wasm/test/ast_printer.ml | 12 +- src/lib_scoru_wasm/test/test_input.ml | 8 + src/lib_scoru_wasm/test/test_output.ml | 179 ++++++++++++++++++ src/lib_scoru_wasm/test/test_scoru_wasm.ml | 1 + src/lib_scoru_wasm/test/test_wasm_encoding.ml | 54 ++++-- src/lib_scoru_wasm/wasm_encoding.ml | 29 ++- src/lib_scoru_wasm/wasm_encoding.mli | 2 + src/lib_webassembly/exec/eval.ml | 25 ++- src/lib_webassembly/exec/eval.mli | 3 + src/lib_webassembly/host/env.ml | 5 +- src/lib_webassembly/host/spectest.ml | 2 +- src/lib_webassembly/runtime/host_funcs.ml | 1 + src/lib_webassembly/runtime/host_funcs.mli | 1 + src/lib_webassembly/runtime/instance.ml | 2 + src/lib_webassembly/runtime/output_buffer.ml | 40 ++++ 18 files changed, 471 insertions(+), 42 deletions(-) create mode 100644 src/lib_scoru_wasm/test/test_output.ml create mode 100644 src/lib_webassembly/runtime/output_buffer.ml diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml index e5febe7ad152..f27aaea1bb6f 100644 --- a/src/lib_scoru_wasm/host_funcs.ml +++ b/src/lib_scoru_wasm/host_funcs.ml @@ -28,13 +28,24 @@ open Instance exception Bad_input -let aux_write_input_in_memory ~input_buffer ~module_inst ~rtype_offset - ~level_offset ~id_offset ~dst ~max_bytes = - let open Lwt.Syntax in +let retrieve_memory module_inst = let memories = module_inst.memories in + match Vector.num_elements memories with + | 1l -> Vector.get 0l memories + | _ -> + raise + (Eval.Crash + (Source.no_region, "the memories is supposed to be a singleton")) + +let aux_write_input_in_memory ~input_buffer ~output_buffer ~module_inst + ~rtype_offset ~level_offset ~id_offset ~dst ~max_bytes = + let open Lwt.Syntax in + let output_level = Output_buffer.get_level output_buffer in let* {rtype; raw_level; message_counter; payload} = Input_buffer.dequeue input_buffer in + if raw_level > output_level then + Output_buffer.set_level output_buffer raw_level ; let input_size = Bytes.length payload in if Int64.of_int input_size > 4096L then raise (Eval.Crash (Source.no_region, "input too large")) @@ -42,15 +53,7 @@ let aux_write_input_in_memory ~input_buffer ~module_inst ~rtype_offset let payload = Bytes.sub payload 0 @@ min input_size (Int32.to_int max_bytes) in - let* memory = - match Vector.num_elements memories with - | 1l -> Vector.get 0l memories - | _ -> - raise - (Eval.Crash - (Source.no_region, "the memories is supposed to be a singleton")) - in - + let* memory = retrieve_memory module_inst in let _ = Memory.store_bytes memory dst (Bytes.to_string payload) in let _ = Memory.store_num memory rtype_offset 0l (I32 rtype) in let _ = Memory.store_num memory level_offset 0l (I32 raw_level) in @@ -59,6 +62,27 @@ let aux_write_input_in_memory ~input_buffer ~module_inst ~rtype_offset in Lwt.return input_size +let aux_write_output ~input_buffer:_ ~output_buffer ~module_inst ~src ~num_bytes + = + let open Lwt.Syntax in + if num_bytes > 4096l then Lwt.return 1l + else + let num_bytes = Int32.to_int num_bytes in + let* memory = retrieve_memory module_inst in + let* payload = Memory.load_bytes memory src num_bytes in + let level = Output_buffer.get_level output_buffer in + let id = Output_buffer.get_id output_buffer in + let output_info = + Output_buffer.{outbox_level = level; message_index = id} + in + Output_buffer.increase_id output_buffer ; + Output_buffer.Map.set + output_info + (Bytes.of_string payload) + output_buffer.content ; + + Lwt.return 0l + let read_input_type = let input_types = Types. @@ -78,7 +102,7 @@ let read_input_name = "tezos_read_input" let read_input = Host_funcs.Host_func - (fun input_buffer module_inst inputs -> + (fun input_buffer output_buffer module_inst inputs -> let open Lwt.Syntax in match inputs with | [ @@ -91,6 +115,7 @@ let read_input = let* x = aux_write_input_in_memory ~input_buffer + ~output_buffer ~module_inst ~rtype_offset ~level_offset @@ -101,17 +126,53 @@ let read_input = Lwt.return [Values.(Num (I32 (I32.of_int_s x)))] | _ -> raise Bad_input) +let write_output_name = "tezos_write_output" + +let write_output_type = + let input_types = + Types.[NumType I32Type; NumType I32Type] |> Vector.of_list + in + let output_types = Types.[NumType I32Type] |> Vector.of_list in + Types.FuncType (input_types, output_types) + +let write_output = + Host_funcs.Host_func + (fun input_buffer output_buffer module_inst inputs -> + let open Lwt.Syntax in + match inputs with + | [Values.(Num (I32 src)); Values.(Num (I32 num_bytes))] -> + let* x = + aux_write_output + ~input_buffer + ~output_buffer + ~module_inst + ~src + ~num_bytes + in + Lwt.return [Values.(Num (I32 x))] + | _ -> raise Bad_input) + let lookup name = let open Lwt.Syntax in let+ name = Utf8.encode name in match name with | "read_input" -> ExternFunc (HostFunc (read_input_type, read_input_name)) + | "write_output" -> + ExternFunc (HostFunc (write_output_type, write_output_name)) | _ -> raise Not_found let register_host_funcs registry = - Host_funcs.register ~global_name:read_input_name read_input registry + List.fold_left + (fun _acc (global_name, host_function) -> + Host_funcs.register ~global_name host_function registry) + () + [(read_input_name, read_input); (write_output_name, write_output)] module Internal_for_tests = struct + let aux_write_output = aux_write_output + + let write_output = Func.HostFunc (write_output_type, write_output_name) + let aux_write_input_in_memory = aux_write_input_in_memory let read_input = Func.HostFunc (read_input_type, read_input_name) diff --git a/src/lib_scoru_wasm/host_funcs.mli b/src/lib_scoru_wasm/host_funcs.mli index 871a25802ddc..1c6f0a21a005 100644 --- a/src/lib_scoru_wasm/host_funcs.mli +++ b/src/lib_scoru_wasm/host_funcs.mli @@ -51,15 +51,32 @@ val register_host_funcs : exception Bad_input module Internal_for_tests : sig + (** [aux_write_output ~input_buffer ~output_buffer ~module_inst ~src + ~num_bytes] reads num_bytes from the memory of module_inst starting at + src and writes this to the output_buffer. It also checks that + the input payload is no larger than `max_output`. It returns 0 for Ok and + 1 for `output too large`.*) + val aux_write_output : + input_buffer:Tezos_webassembly_interpreter.Input_buffer.t -> + output_buffer:Tezos_webassembly_interpreter.Output_buffer.t -> + module_inst:Tezos_webassembly_interpreter.Instance.module_inst -> + src:int32 -> + num_bytes:int32 -> + int32 Lwt.t + + val write_output : Tezos_webassembly_interpreter.Instance.func_inst + (** [aux_write_memory ~input_buffer ~module_inst ~rtype_offset ~level_offset ~id_offset ~dst ~max_bytes] reads `input_buffer` and writes its components to the memory of `module_inst` based on the memory addreses offsets described. It also checks that the input payload is no larger than `max_input` and crashes with `input too large` otherwise. It returns the size of the - payload.*) + payload. Note also that, if the level increases this function also + updates the level of the output buffer and resets its id to zero.*) val aux_write_input_in_memory : input_buffer:Tezos_webassembly_interpreter.Input_buffer.t -> + output_buffer:Tezos_webassembly_interpreter.Output_buffer.t -> module_inst:Tezos_webassembly_interpreter.Instance.module_inst -> rtype_offset:int32 -> level_offset:int32 -> diff --git a/src/lib_scoru_wasm/test/ast_generators.ml b/src/lib_scoru_wasm/test/ast_generators.ml index 36dd373df95f..3472525a4627 100644 --- a/src/lib_scoru_wasm/test/ast_generators.ml +++ b/src/lib_scoru_wasm/test/ast_generators.ml @@ -27,6 +27,8 @@ open Tezos_webassembly_interpreter open Lazy_containers open QCheck2.Gen +let to_int32 = Bounded.Int32.NonNegative.to_int32 + let no_region it = Source.{it; at = no_region} let var_gen = @@ -594,10 +596,47 @@ let input_buffer_gen = num_elements = Z.of_int num_elements; } +let output_info_gen = + let* level = small_int in + let outbox_level = Int32.of_int level in + let* message_index = map Z.of_int small_nat in + return Output_buffer.{outbox_level; message_index} + +let output_buffer_gen = + let* seeds = small_list int in + let* l = small_list int in + let level = 0l in + let content = + Output_buffer.Map.create + ~produce_value:(fun {message_index; _} -> + let rand = + Random.State.make @@ Array.of_list (Z.to_int message_index :: seeds) + in + Lwt.return @@ generate1 ~rand + @@ map Bytes.of_string (small_string ~gen:char)) + () + in + let level = + List.fold_left + (fun acc ix -> + let rand = Random.State.make @@ Array.of_list (ix :: seeds) in + let key = generate1 ~rand output_info_gen in + let _ = Output_buffer.Map.get key content in + Int32.max acc key.outbox_level) + level + l + in + return Output_buffer.{content; level; id = Z.zero} + let config_gen ~host_funcs ~module_reg = let* frame = frame_gen ~module_reg in let* input = input_buffer_gen in + let _input_list = + Lazy_vector.LwtZVector.to_list + @@ Lazy_vector.Mutable.LwtZVector.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; code = (values, instrs); host_funcs; budget} + Eval.{frame; input; output; code = (values, instrs); host_funcs; budget} diff --git a/src/lib_scoru_wasm/test/ast_printer.ml b/src/lib_scoru_wasm/test/ast_printer.ml index caf4af331409..781c6318d526 100644 --- a/src/lib_scoru_wasm/test/ast_printer.ml +++ b/src/lib_scoru_wasm/test/ast_printer.ml @@ -626,12 +626,20 @@ let pp_input_buffer out input = (Lazy_vector.Mutable.ZVector.snapshot input.content) (Z.to_string input.num_elements) +let pp_output_buffer out (output : Output_buffer.t) = + let open Output_buffer.Map in + Format.fprintf + out + "@[%s@]" + (Map.to_string (fun x -> Bytes.to_string x) @@ snapshot output.content) + let pp_config out - Eval.{frame; input; code = values, instrs; host_funcs = _; budget} = + Eval.{frame; input; output; code = values, instrs; host_funcs = _; budget} = Format.fprintf out "@[{frame = %a;@;\ input = %a;@;\ + output = %a;@;\ instructions = %a;@;\ values = %a;@;\ budget = %i;@;\ @@ -640,6 +648,8 @@ let pp_config out frame pp_input_buffer input + pp_output_buffer + output (Format.pp_print_list pp_admin_instr) instrs (Format.pp_print_list pp_value) diff --git a/src/lib_scoru_wasm/test/test_input.ml b/src/lib_scoru_wasm/test/test_input.ml index b285018a1db8..e05ad5da1083 100644 --- a/src/lib_scoru_wasm/test/test_input.ml +++ b/src/lib_scoru_wasm/test/test_input.ml @@ -83,6 +83,8 @@ let read_input () = let lim = Types.(MemoryType {min = 100l; max = Some 1000l}) in let memory = Memory.alloc lim in let input_buffer = Input_buffer.alloc () in + let output_buffer = Output_buffer.alloc () in + Output_buffer.increase_id output_buffer ; let* () = Input_buffer.enqueue input_buffer @@ -104,6 +106,7 @@ let read_input () = let* result = Host_funcs.Internal_for_tests.aux_write_input_in_memory ~input_buffer + ~output_buffer ~module_inst ~rtype_offset:0l ~level_offset:4l @@ -114,6 +117,10 @@ let read_input () = let* memory = Tezos_webassembly_interpreter.Instance.Vector.get 0l module_inst.memories in + let output_level = Output_buffer.get_level output_buffer in + let output_id = Output_buffer.get_id output_buffer in + assert (output_level = 2l) ; + assert (output_id = Z.zero) ; assert (Input_buffer.num_elements input_buffer = Z.zero) ; assert (result = 5) ; let* m = Memory.load_bytes memory 0l 1 in @@ -364,6 +371,7 @@ let test_set_input () = { frame = {inst = Module_key "main"; locals = []}; input = Input_buffer.alloc (); + output = Output_buffer.alloc (); code = ([], []); host_funcs; budget = 1000; diff --git a/src/lib_scoru_wasm/test/test_output.ml b/src/lib_scoru_wasm/test/test_output.ml new file mode 100644 index 000000000000..dcdd78e6a0f2 --- /dev/null +++ b/src/lib_scoru_wasm/test/test_output.ml @@ -0,0 +1,179 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Trili Tech *) +(* *) +(* 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. *) +(* *) +(*****************************************************************************) + +(** Testing + ------- + Component: Lib_scoru_wasm input + Invocation: dune exec src/lib_scoru_wasm/test/test_scoru_wasm.exe \ + -- test "Output" + Subject: Input tests for the tezos-scoru-wasm library +*) + +open Tztest +open Lazy_containers +open Tezos_webassembly_interpreter +open Tezos_scoru_wasm + +let test_aux_write_output () = + let open Lwt.Syntax in + let lim = Types.(MemoryType {min = 100l; max = Some 1000l}) in + let memory = Memory.alloc lim in + let input_buffer = Input_buffer.alloc () in + let output_buffer = Output_buffer.alloc () in + let* () = + Input_buffer.enqueue + input_buffer + { + rtype = 1l; + raw_level = 2l; + message_counter = Z.of_int 2; + payload = Bytes.of_string "hello"; + } + in + assert (Input_buffer.num_elements input_buffer = Z.one) ; + let module_inst = Tezos_webassembly_interpreter.Instance.empty_module_inst in + let memories = + Tezos_webassembly_interpreter.Instance.Vector.cons + memory + module_inst.memories + in + let module_inst = {module_inst with memories} in + let* _ = + Host_funcs.Internal_for_tests.aux_write_input_in_memory + ~input_buffer + ~output_buffer + ~module_inst + ~rtype_offset:0l + ~level_offset:4l + ~id_offset:10l + ~dst:50l + ~max_bytes:36000l + in + let output_level = Output_buffer.get_level output_buffer in + assert (output_level = 2l) ; + let* result = + Host_funcs.Internal_for_tests.aux_write_output + ~input_buffer + ~output_buffer + ~module_inst + ~src:50l + ~num_bytes:5l + in + let* z = + Output_buffer.( + Map.get {outbox_level = 2l; message_index = Z.zero} output_buffer.content) + in + assert (result = 0l) ; + assert (Output_buffer.get_level output_buffer = output_level) ; + assert (Output_buffer.get_id output_buffer = Z.one) ; + assert (z = Bytes.of_string "hello") ; + + Lwt.return @@ Result.return_unit + +let test_write_host_fun () = + let open Lwt.Syntax in + let input = Input_buffer.alloc () in + let output = Output_buffer.alloc () in + let* () = + Input_buffer.enqueue + input + { + rtype = 1l; + raw_level = 2l; + message_counter = Z.of_int 2; + payload = Bytes.of_string "hello"; + } + in + let module_inst = Tezos_webassembly_interpreter.Instance.empty_module_inst in + let memories = + Lazy_vector.LwtInt32Vector.cons + (Memory.alloc (MemoryType Types.{min = 20l; max = Some 3600l})) + module_inst.memories + in + let module_inst = {module_inst with memories} in + let values = + Values. + [ + Num (I32 0l); Num (I32 4l); Num (I32 10l); Num (I32 50l); Num (I32 3600l); + ] + in + let host_funcs_registry = Tezos_webassembly_interpreter.Host_funcs.empty () in + Host_funcs.register_host_funcs host_funcs_registry ; + + let module_reg = Instance.ModuleMap.create () in + let module_key = Instance.Module_key "test" in + Instance.update_module_ref module_reg module_key module_inst ; + + let* _ = + Eval.invoke + ~module_reg + ~caller:module_key + host_funcs_registry + ~input + ~output + Host_funcs.Internal_for_tests.read_input + values + in + let values = Values.[Num (I32 50l); Num (I32 5l)] in + + let* result = + Eval.invoke + ~module_reg + ~caller:module_key + host_funcs_registry + ~input + ~output + Host_funcs.Internal_for_tests.write_output + values + in + let* z = + Output_buffer.( + Map.get {outbox_level = 2l; message_index = Z.zero} output.content) + in + assert (result = Values.[Num (I32 0l)]) ; + assert (z = Bytes.of_string "hello") ; + assert (Output_buffer.get_level output = 2l) ; + assert (Output_buffer.get_id output = Z.one) ; + let values = Values.[Num (I32 50l); Num (I32 5000l)] in + let* result = + Eval.invoke + ~module_reg + ~caller:module_key + host_funcs_registry + ~input + ~output + Host_funcs.Internal_for_tests.write_output + values + in + assert (result = Values.[Num (I32 1l)]) ; + assert (Output_buffer.get_level output = 2l) ; + assert (Output_buffer.get_id output = Z.one) ; + Lwt.return @@ Result.return_unit + +let tests = + [ + tztest "Aux_write_output" `Quick test_aux_write_output; + tztest "Host write" `Quick test_write_host_fun; + ] diff --git a/src/lib_scoru_wasm/test/test_scoru_wasm.ml b/src/lib_scoru_wasm/test/test_scoru_wasm.ml index f4697d6eb4f8..89e4d0e95a9a 100644 --- a/src/lib_scoru_wasm/test/test_scoru_wasm.ml +++ b/src/lib_scoru_wasm/test/test_scoru_wasm.ml @@ -35,6 +35,7 @@ let () = "test lib scoru wasm" [ ("Input", Test_input.tests); + ("Output", Test_output.tests); ("AST Generators", Test_ast_generators.tests); ("WASM Encodings", Test_wasm_encoding.tests); ("Parser Encodings", Test_parser_encoding.tests); diff --git a/src/lib_scoru_wasm/test/test_wasm_encoding.ml b/src/lib_scoru_wasm/test/test_wasm_encoding.ml index 17b96a80c937..4a915c38e73b 100644 --- a/src/lib_scoru_wasm/test/test_wasm_encoding.ml +++ b/src/lib_scoru_wasm/test/test_wasm_encoding.ml @@ -126,7 +126,8 @@ let test_module_roundtrip () = More formally, test that for all values, encoding, decoding and re-encoding yields the same tree. *) -let test_generic_tree ~pp ~gen ~encoding = +let test_generic_tree ~pp ~gen ~encoding + ?(evaluate = fun _v1 v2 -> Format.asprintf "%a" pp v2) () = let print = Format.asprintf "%a" pp in let open Lwt_result_syntax in let dummy_module_reg = @@ -137,14 +138,18 @@ let test_generic_tree ~pp ~gen ~encoding = let host_funcs = Host_funcs.empty () in qcheck ~print (gen ~host_funcs ~module_reg:dummy_module_reg) (fun value1 -> let*! empty_tree = empty_tree () in - (* We need to print here in order to force lazy bindings to be evaluated. *) - let _ = print value1 in + (* We use an evaluate here in order to force lazy bindings to be + evaluated. In the case of a lazy_vector this is just a print function + but for lazy maps things are more complicated *) + let _ = evaluate value1 value1 in let*! tree1 = Tree_encoding_runner.encode (encoding ~host_funcs) value1 empty_tree in let*! value2 = Tree_encoding_runner.decode (encoding ~host_funcs) tree1 in - (* We need to print here in order to force lazy bindings to be evaluated. *) - let _ = print value2 in + (* We use an evaluate here in order to force lazy bindings to be + evaluated. In the case of a lazy_vector this is just a print function + but for lazy maps things are more complicated *) + let _ = evaluate value1 value2 in let*! tree2 = Tree_encoding_runner.encode (encoding ~host_funcs) value2 empty_tree in @@ -152,7 +157,7 @@ let test_generic_tree ~pp ~gen ~encoding = return_unit) (** Test serialize/deserialize modules and compare trees. *) -let test_module_tree () = +let test_module_tree = test_generic_tree ~pp:Ast_printer.pp_module ~gen:(fun ~host_funcs:_ ~module_reg -> @@ -160,21 +165,41 @@ let test_module_tree () = ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.module_instance_encoding) (** Test serialize/deserialize frames and compare trees. *) -let test_frame_tree () = +let test_frame_tree = test_generic_tree ~pp:Ast_printer.pp_frame ~gen:(fun ~host_funcs:_ -> Ast_generators.frame_gen) ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.frame_encoding) (** Test serialize/deserialize input buffers and compare trees. *) -let test_input_buffer_tree () = +let test_input_buffer_tree = test_generic_tree ~pp:Ast_printer.pp_input_buffer ~gen:(fun ~host_funcs:_ ~module_reg:_ -> Ast_generators.input_buffer_gen) ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.input_buffer_encoding) +let evaluate (v1 : Output_buffer.t) (v2 : Output_buffer.t) = + let bindings = + List.map fst Output_buffer.Map.(Map.loaded_bindings @@ snapshot v1.content) + in + List.fold_left + (fun () x -> + let _ = Output_buffer.Map.get x v2.content in + ()) + () + bindings ; + "" + +(** Test serialize/deserialize output buffers and compare trees. *) +let test_output_buffer_tree = + test_generic_tree + ~evaluate + ~pp:Ast_printer.pp_output_buffer + ~gen:(fun ~host_funcs:_ ~module_reg:_ -> Ast_generators.output_buffer_gen) + ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.output_buffer_encoding) + (** Test serialize/deserialize values and compare trees. *) -let test_values_tree () = +let test_values_tree = test_generic_tree ~pp:(Format.pp_print_list Ast_printer.pp_value) ~gen:(fun ~host_funcs:_ ~module_reg:_ -> @@ -182,16 +207,22 @@ let test_values_tree () = ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.values_encoding) (** Test serialize/deserialize administrative instructions and compare trees. *) -let test_admin_instr_tree () = +let test_admin_instr_tree = test_generic_tree ~pp:Ast_printer.pp_admin_instr ~gen:(fun ~host_funcs:_ ~module_reg -> Ast_generators.admin_instr_gen ~module_reg) ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.admin_instr_encoding) +let config_evaluate (v1 : Eval.config) (v2 : Eval.config) = + let v1out, v2out = (v1.output, v2.output) in + let _ = evaluate v1out v2out in + Format.asprintf "%a" Ast_printer.pp_config v2 + (** Test serialize/deserialize evaluation configuration and compare trees. *) -let test_config_tree () = +let test_config_tree = test_generic_tree + ~evaluate:config_evaluate ~pp:Ast_printer.pp_config ~gen:Ast_generators.config_gen ~encoding:Wasm_encoding.config_encoding @@ -204,6 +235,7 @@ let tests = tztest "Values trees" `Quick test_values_tree; tztest "Admin_instr trees" `Quick test_admin_instr_tree; tztest "Input_buffer trees" `Quick test_input_buffer_tree; + tztest "Output_buffer trees" `Quick test_output_buffer_tree; tztest "Frame trees" `Quick test_frame_tree; tztest "Config trees" `Quick test_config_tree; ] diff --git a/src/lib_scoru_wasm/wasm_encoding.ml b/src/lib_scoru_wasm/wasm_encoding.ml index 44b1522a65ff..9b8d6847295a 100644 --- a/src/lib_scoru_wasm/wasm_encoding.ml +++ b/src/lib_scoru_wasm/wasm_encoding.ml @@ -838,16 +838,35 @@ let input_buffer_encoding = input_buffer_message_encoding)) (value ["num-messages"] Data_encoding.z)) +module Output_bufferMap = Lazy_map_encoding.Make (Output_buffer.Map.Map) + +let output_content_encoding = + conv + Output_buffer.Map.of_immutable + Output_buffer.Map.snapshot + (Output_bufferMap.lazy_map (value [] Data_encoding.bytes)) + +let output_buffer_encoding = + conv + (fun (content, level, id) -> Output_buffer.{content; level; id}) + (fun Output_buffer.{content; level; id} -> (content, level, id)) + (tup3 + ~flatten:true + output_content_encoding + (value ["level"] Data_encoding.int32) + (value ["id"] Data_encoding.z)) + let config_encoding ~host_funcs = conv - (fun (frame, input, instrs, values, budget) -> - Eval.{frame; input; code = (values, instrs); host_funcs; budget}) - (fun Eval.{frame; input; code = values, instrs; budget; _} -> - (frame, input, instrs, values, budget)) - (tup5 + (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 ~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)) diff --git a/src/lib_scoru_wasm/wasm_encoding.mli b/src/lib_scoru_wasm/wasm_encoding.mli index 4cea6efaae5e..8ee4913461d1 100644 --- a/src/lib_scoru_wasm/wasm_encoding.mli +++ b/src/lib_scoru_wasm/wasm_encoding.mli @@ -88,6 +88,8 @@ val module_instances_encoding : Instance.module_reg Tree_encoding.t val input_buffer_encoding : Input_buffer.t Tree_encoding.t +val output_buffer_encoding : Output_buffer.t Tree_encoding.t + val admin_instr_encoding : Eval.admin_instr Tree_encoding.t val frame_encoding : Eval.frame Tree_encoding.t diff --git a/src/lib_webassembly/exec/eval.ml b/src/lib_webassembly/exec/eval.ml index 460ef5ca4531..086c2eca8a11 100644 --- a/src/lib_webassembly/exec/eval.ml +++ b/src/lib_webassembly/exec/eval.ml @@ -75,6 +75,7 @@ and admin_instr' = type config = { frame : frame; input : input_inst; + output : output_inst; code : code; host_funcs : Host_funcs.registry; budget : int; (* to model stack overflow *) @@ -82,8 +83,16 @@ type config = { let frame inst locals = {inst; locals} -let config ?(input = Input_buffer.alloc ()) host_funcs inst vs es = - {frame = frame inst []; input; code = (vs, es); budget = 300; host_funcs} +let config ?(input = Input_buffer.alloc ()) ?(output = Output_buffer.alloc ()) + host_funcs inst vs es = + { + frame = frame inst []; + input; + output; + code = (vs, es); + budget = 300; + host_funcs; + } let plain e = Plain e.it @@ e.at @@ -800,6 +809,7 @@ and step_resolved module_reg (c : config) frame vs e es : config Lwt.t = frame = frame'; code = code'; budget = c.budget - 1; + output = c.output; input = c.input; host_funcs = c.host_funcs; } @@ -837,7 +847,7 @@ and step_resolved module_reg (c : config) frame vs e es : config Lwt.t = Host_funcs.lookup ~global_name c.host_funcs in let* inst = resolve_module_ref module_reg frame.inst in - let+ res = f c.input inst (List.rev args) in + let+ res = f c.input c.output inst (List.rev args) in (List.rev res @ vs', [])) (function | Crash (_, msg) -> Crash.error e.at msg | exn -> raise exn)) @@ -854,8 +864,9 @@ let rec eval module_reg (c : config) : value stack Lwt.t = (* Functions & Constants *) -let invoke ~module_reg ~caller ?(input = Input_buffer.alloc ()) host_funcs - (func : func_inst) (vs : value list) : value list Lwt.t = +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* ins_l = Lazy_vector.Int32Vector.to_list ins in @@ -871,7 +882,9 @@ let invoke ~module_reg ~caller ?(input = Input_buffer.alloc ()) host_funcs | Func.AstFunc (_, inst, _) -> inst | Func.HostFunc (_, _) -> caller in - let c = config ~input host_funcs inst (List.rev vs) [Invoke func @@ at] in + let c = + config ~input ~output host_funcs inst (List.rev vs) [Invoke func @@ at] + in Lwt.catch (fun () -> let+ values = eval module_reg c in diff --git a/src/lib_webassembly/exec/eval.mli b/src/lib_webassembly/exec/eval.mli index 251efcc959b6..b4bd5845e297 100644 --- a/src/lib_webassembly/exec/eval.mli +++ b/src/lib_webassembly/exec/eval.mli @@ -111,6 +111,7 @@ val invoke : module_reg:module_reg -> caller:module_key -> ?input:Input_buffer.t -> + ?output:Output_buffer.t -> Host_funcs.registry -> func_inst -> value list -> @@ -119,6 +120,7 @@ val invoke : type config = { frame : frame; input : input_inst; + output : output_inst; code : code; host_funcs : Host_funcs.registry; budget : int; (* to model stack overflow *) @@ -128,6 +130,7 @@ val step : module_reg -> config -> config Lwt.t val config : ?input:input_inst -> + ?output:output_inst -> Host_funcs.registry -> module_key -> value list -> diff --git a/src/lib_webassembly/host/env.ml b/src/lib_webassembly/host/env.ml index cb303c32eca7..1f44dd990a9f 100644 --- a/src/lib_webassembly/host/env.ml +++ b/src/lib_webassembly/host/env.ml @@ -28,13 +28,14 @@ let int = function let abort = Host_funcs.Host_func - (fun _input _mod_inst vs -> + (fun _input _output _mod_inst vs -> empty vs ; print_endline "Abort!" ; exit (-1)) let exit = - Host_funcs.Host_func (fun _input _mod_inst vs -> exit (int (single vs))) + Host_funcs.Host_func + (fun _input _output _mod_inst vs -> exit (int (single vs))) let register_host_funcs registry = Host_funcs.register ~global_name:"abort" abort registry ; diff --git a/src/lib_webassembly/host/spectest.ml b/src/lib_webassembly/host/spectest.ml index 8e93f8562f68..595e77559e3f 100644 --- a/src/lib_webassembly/host/spectest.ml +++ b/src/lib_webassembly/host/spectest.ml @@ -34,7 +34,7 @@ let print_value v = let print = Host_funcs.Host_func - (fun _i _m vs -> + (fun _i _o _m vs -> List.iter print_value vs ; flush_all () ; Lwt.return_nil) diff --git a/src/lib_webassembly/runtime/host_funcs.ml b/src/lib_webassembly/runtime/host_funcs.ml index d459ccb94063..42c8770d867e 100644 --- a/src/lib_webassembly/runtime/host_funcs.ml +++ b/src/lib_webassembly/runtime/host_funcs.ml @@ -1,6 +1,7 @@ type host_func = | Host_func of (Input_buffer.t -> + Output_buffer.t -> Instance.module_inst -> Values.value list -> Values.value list Lwt.t) diff --git a/src/lib_webassembly/runtime/host_funcs.mli b/src/lib_webassembly/runtime/host_funcs.mli index 75ae6720d5e7..23e257e6e6dd 100644 --- a/src/lib_webassembly/runtime/host_funcs.mli +++ b/src/lib_webassembly/runtime/host_funcs.mli @@ -2,6 +2,7 @@ type host_func = | Host_func of (Input_buffer.t -> + Output_buffer.t -> Instance.module_inst -> Values.value list -> Values.value list Lwt.t) diff --git a/src/lib_webassembly/runtime/instance.ml b/src/lib_webassembly/runtime/instance.ml index c50ebe848d39..6ac460e4475f 100644 --- a/src/lib_webassembly/runtime/instance.ml +++ b/src/lib_webassembly/runtime/instance.ml @@ -40,6 +40,8 @@ and global_inst = Global.t and input_inst = Input_buffer.t +and output_inst = Output_buffer.t + and export_inst = Ast.name * extern and elem_inst = Values.ref_ Vector.t ref diff --git a/src/lib_webassembly/runtime/output_buffer.ml b/src/lib_webassembly/runtime/output_buffer.ml new file mode 100644 index 000000000000..58350bf25fd2 --- /dev/null +++ b/src/lib_webassembly/runtime/output_buffer.ml @@ -0,0 +1,40 @@ +type output_info = { + outbox_level : int32; (** The outbox level at which the message exists.*) + message_index : Z.t; (** The index of the message in the outbox. *) +} + +exception Id_too_large + +module OutputKey : Lazy_map.KeyS with type t = output_info = struct + type t = output_info + + let compare {outbox_level = l1; message_index = i1} + {outbox_level = l2; message_index = i2} = + let c1 = compare l1 l2 in + if c1 = 0 then Z.compare i1 i2 else c1 + + let to_string {outbox_level; message_index} = + Format.sprintf + "Outboxlevel= %li; message_index=%s" + outbox_level + (Z.to_string message_index) +end + +module Map = Lazy_map.Mutable.Make (OutputKey) + +type t = {content : bytes Map.t; mutable level : int32; mutable id : Z.t} + +let get_level output = output.level + +let get_id output = output.id + +let set_level output level = + if level > output.level then ( + output.level <- level ; + output.id <- Z.zero) + +let increase_id output = + let id = Z.succ output.id in + if id > Z.of_int32 Int32.max_int then raise Id_too_large else output.id <- id + +let alloc () = {content = Map.create (); level = 0l; id = Z.zero} -- GitLab From a59d2a1836123f1c6146a3c35c619a590e660261 Mon Sep 17 00:00:00 2001 From: Corneliu Hoffman Date: Thu, 25 Aug 2022 09:59:03 +0100 Subject: [PATCH 2/2] SCORU/WASM: changed data structures for Output_buffer --- src/lib_scoru_wasm/host_funcs.ml | 16 +---- src/lib_scoru_wasm/test/ast_generators.ml | 36 +++------- src/lib_scoru_wasm/test/ast_printer.ml | 13 +++- src/lib_scoru_wasm/test/test_input.ml | 6 +- src/lib_scoru_wasm/test/test_output.ml | 27 ++++---- src/lib_scoru_wasm/test/test_wasm_encoding.ml | 35 ++-------- src/lib_scoru_wasm/wasm_encoding.ml | 20 ++---- src/lib_webassembly/runtime/output_buffer.ml | 69 ++++++++++++------- 8 files changed, 93 insertions(+), 129 deletions(-) diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml index f27aaea1bb6f..55e070aa8fd2 100644 --- a/src/lib_scoru_wasm/host_funcs.ml +++ b/src/lib_scoru_wasm/host_funcs.ml @@ -40,12 +40,10 @@ let retrieve_memory module_inst = let aux_write_input_in_memory ~input_buffer ~output_buffer ~module_inst ~rtype_offset ~level_offset ~id_offset ~dst ~max_bytes = let open Lwt.Syntax in - let output_level = Output_buffer.get_level output_buffer in let* {rtype; raw_level; message_counter; payload} = Input_buffer.dequeue input_buffer in - if raw_level > output_level then - Output_buffer.set_level output_buffer raw_level ; + Output_buffer.set_level output_buffer raw_level ; let input_size = Bytes.length payload in if Int64.of_int input_size > 4096L then raise (Eval.Crash (Source.no_region, "input too large")) @@ -70,17 +68,7 @@ let aux_write_output ~input_buffer:_ ~output_buffer ~module_inst ~src ~num_bytes let num_bytes = Int32.to_int num_bytes in let* memory = retrieve_memory module_inst in let* payload = Memory.load_bytes memory src num_bytes in - let level = Output_buffer.get_level output_buffer in - let id = Output_buffer.get_id output_buffer in - let output_info = - Output_buffer.{outbox_level = level; message_index = id} - in - Output_buffer.increase_id output_buffer ; - Output_buffer.Map.set - output_info - (Bytes.of_string payload) - output_buffer.content ; - + let* () = Output_buffer.set_value output_buffer (Bytes.of_string payload) in Lwt.return 0l let read_input_type = diff --git a/src/lib_scoru_wasm/test/ast_generators.ml b/src/lib_scoru_wasm/test/ast_generators.ml index 3472525a4627..f7b7c3be3b5d 100644 --- a/src/lib_scoru_wasm/test/ast_generators.ml +++ b/src/lib_scoru_wasm/test/ast_generators.ml @@ -27,8 +27,6 @@ open Tezos_webassembly_interpreter open Lazy_containers open QCheck2.Gen -let to_int32 = Bounded.Int32.NonNegative.to_int32 - let no_region it = Source.{it; at = no_region} let var_gen = @@ -603,37 +601,25 @@ let output_info_gen = return Output_buffer.{outbox_level; message_index} let output_buffer_gen = - let* seeds = small_list int in let* l = small_list int in - let level = 0l in - let content = - Output_buffer.Map.create - ~produce_value:(fun {message_index; _} -> - let rand = - Random.State.make @@ Array.of_list (Z.to_int message_index :: seeds) - in - Lwt.return @@ generate1 ~rand - @@ map Bytes.of_string (small_string ~gen:char)) - () - in - let level = - List.fold_left - (fun acc ix -> - let rand = Random.State.make @@ Array.of_list (ix :: seeds) in - let key = generate1 ~rand output_info_gen in - let _ = Output_buffer.Map.get key content in - Int32.max acc key.outbox_level) - level + let s = + List.map + (fun _ -> + generate1 + @@ map + (fun a -> + Output_buffer.Index_Vector.(of_immutable @@ Vector.of_list a)) + (list (map Bytes.of_string string))) l in - return Output_buffer.{content; level; id = Z.zero} + return Output_buffer.Level_Vector.(of_immutable @@ Vector.of_list s) let config_gen ~host_funcs ~module_reg = let* frame = frame_gen ~module_reg in let* input = input_buffer_gen in let _input_list = - Lazy_vector.LwtZVector.to_list - @@ Lazy_vector.Mutable.LwtZVector.snapshot input.content + 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 diff --git a/src/lib_scoru_wasm/test/ast_printer.ml b/src/lib_scoru_wasm/test/ast_printer.ml index 781c6318d526..44fa6a3778c1 100644 --- a/src/lib_scoru_wasm/test/ast_printer.ml +++ b/src/lib_scoru_wasm/test/ast_printer.ml @@ -626,12 +626,19 @@ let pp_input_buffer out input = (Lazy_vector.Mutable.ZVector.snapshot input.content) (Z.to_string input.num_elements) +let pp_index_vector out index_vector = + Format.fprintf + out + "@[%a@]" + (pp_vector_z (fun o x -> Format.fprintf o "@[%s@]" (Bytes.to_string x))) + (Output_buffer.Index_Vector.snapshot index_vector) + let pp_output_buffer out (output : Output_buffer.t) = - let open Output_buffer.Map in Format.fprintf out - "@[%s@]" - (Map.to_string (fun x -> Bytes.to_string x) @@ snapshot output.content) + "@[%a@]" + (pp_vector (fun o -> pp_index_vector o)) + (Output_buffer.Level_Vector.snapshot output) let pp_config out Eval.{frame; input; output; code = values, instrs; host_funcs = _; budget} = diff --git a/src/lib_scoru_wasm/test/test_input.ml b/src/lib_scoru_wasm/test/test_input.ml index e05ad5da1083..410ae79da4dd 100644 --- a/src/lib_scoru_wasm/test/test_input.ml +++ b/src/lib_scoru_wasm/test/test_input.ml @@ -84,7 +84,6 @@ let read_input () = let memory = Memory.alloc lim in let input_buffer = Input_buffer.alloc () in let output_buffer = Output_buffer.alloc () in - Output_buffer.increase_id output_buffer ; let* () = Input_buffer.enqueue input_buffer @@ -117,10 +116,9 @@ let read_input () = let* memory = Tezos_webassembly_interpreter.Instance.Vector.get 0l module_inst.memories in - let output_level = Output_buffer.get_level output_buffer in - let output_id = Output_buffer.get_id output_buffer in + let* output_level, output_id = Output_buffer.get_id output_buffer in assert (output_level = 2l) ; - assert (output_id = Z.zero) ; + assert (output_id = Z.of_int (-1)) ; assert (Input_buffer.num_elements input_buffer = Z.zero) ; assert (result = 5) ; let* m = Memory.load_bytes memory 0l 1 in diff --git a/src/lib_scoru_wasm/test/test_output.ml b/src/lib_scoru_wasm/test/test_output.ml index dcdd78e6a0f2..33682f41fb6d 100644 --- a/src/lib_scoru_wasm/test/test_output.ml +++ b/src/lib_scoru_wasm/test/test_output.ml @@ -81,13 +81,11 @@ let test_aux_write_output () = ~src:50l ~num_bytes:5l in - let* z = - Output_buffer.( - Map.get {outbox_level = 2l; message_index = Z.zero} output_buffer.content) - in + let* z = Output_buffer.get output_buffer 2l Z.zero in assert (result = 0l) ; - assert (Output_buffer.get_level output_buffer = output_level) ; - assert (Output_buffer.get_id output_buffer = Z.one) ; + let* level, id = Output_buffer.get_id output_buffer in + assert (level = output_level) ; + assert (id = Z.zero) ; assert (z = Bytes.of_string "hello") ; Lwt.return @@ Result.return_unit @@ -108,7 +106,7 @@ let test_write_host_fun () = in let module_inst = Tezos_webassembly_interpreter.Instance.empty_module_inst in let memories = - Lazy_vector.LwtInt32Vector.cons + Lazy_vector.Int32Vector.cons (Memory.alloc (MemoryType Types.{min = 20l; max = Some 3600l})) module_inst.memories in @@ -148,14 +146,12 @@ let test_write_host_fun () = Host_funcs.Internal_for_tests.write_output values in - let* z = - Output_buffer.( - Map.get {outbox_level = 2l; message_index = Z.zero} output.content) - in + let* z = Output_buffer.get output 2l Z.zero in + let* level, id = Output_buffer.get_id output in assert (result = Values.[Num (I32 0l)]) ; assert (z = Bytes.of_string "hello") ; - assert (Output_buffer.get_level output = 2l) ; - assert (Output_buffer.get_id output = Z.one) ; + assert (level = 2l) ; + assert (id = Z.zero) ; let values = Values.[Num (I32 50l); Num (I32 5000l)] in let* result = Eval.invoke @@ -167,9 +163,10 @@ let test_write_host_fun () = Host_funcs.Internal_for_tests.write_output values in + let* level, id = Output_buffer.get_id output in assert (result = Values.[Num (I32 1l)]) ; - assert (Output_buffer.get_level output = 2l) ; - assert (Output_buffer.get_id output = Z.one) ; + assert (level = 2l) ; + assert (id = Z.zero) ; Lwt.return @@ Result.return_unit let tests = diff --git a/src/lib_scoru_wasm/test/test_wasm_encoding.ml b/src/lib_scoru_wasm/test/test_wasm_encoding.ml index 4a915c38e73b..3df7f675148e 100644 --- a/src/lib_scoru_wasm/test/test_wasm_encoding.ml +++ b/src/lib_scoru_wasm/test/test_wasm_encoding.ml @@ -126,8 +126,7 @@ let test_module_roundtrip () = More formally, test that for all values, encoding, decoding and re-encoding yields the same tree. *) -let test_generic_tree ~pp ~gen ~encoding - ?(evaluate = fun _v1 v2 -> Format.asprintf "%a" pp v2) () = +let test_generic_tree ~pp ~gen ~encoding () = let print = Format.asprintf "%a" pp in let open Lwt_result_syntax in let dummy_module_reg = @@ -138,18 +137,14 @@ let test_generic_tree ~pp ~gen ~encoding let host_funcs = Host_funcs.empty () in qcheck ~print (gen ~host_funcs ~module_reg:dummy_module_reg) (fun value1 -> let*! empty_tree = empty_tree () in - (* We use an evaluate here in order to force lazy bindings to be - evaluated. In the case of a lazy_vector this is just a print function - but for lazy maps things are more complicated *) - let _ = evaluate value1 value1 in + (* We need to print here in order to force lazy bindings to be evaluated. *) + let _ = print value1 in let*! tree1 = Tree_encoding_runner.encode (encoding ~host_funcs) value1 empty_tree in let*! value2 = Tree_encoding_runner.decode (encoding ~host_funcs) tree1 in - (* We use an evaluate here in order to force lazy bindings to be - evaluated. In the case of a lazy_vector this is just a print function - but for lazy maps things are more complicated *) - let _ = evaluate value1 value2 in + (* We need to print here in order to force lazy bindings to be evaluated. *) + let _ = print value2 in let*! tree2 = Tree_encoding_runner.encode (encoding ~host_funcs) value2 empty_tree in @@ -178,22 +173,9 @@ let test_input_buffer_tree = ~gen:(fun ~host_funcs:_ ~module_reg:_ -> Ast_generators.input_buffer_gen) ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.input_buffer_encoding) -let evaluate (v1 : Output_buffer.t) (v2 : Output_buffer.t) = - let bindings = - List.map fst Output_buffer.Map.(Map.loaded_bindings @@ snapshot v1.content) - in - List.fold_left - (fun () x -> - let _ = Output_buffer.Map.get x v2.content in - ()) - () - bindings ; - "" - (** Test serialize/deserialize output buffers and compare trees. *) let test_output_buffer_tree = test_generic_tree - ~evaluate ~pp:Ast_printer.pp_output_buffer ~gen:(fun ~host_funcs:_ ~module_reg:_ -> Ast_generators.output_buffer_gen) ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.output_buffer_encoding) @@ -214,15 +196,8 @@ let test_admin_instr_tree = Ast_generators.admin_instr_gen ~module_reg) ~encoding:(fun ~host_funcs:_ -> Wasm_encoding.admin_instr_encoding) -let config_evaluate (v1 : Eval.config) (v2 : Eval.config) = - let v1out, v2out = (v1.output, v2.output) in - let _ = evaluate v1out v2out in - Format.asprintf "%a" Ast_printer.pp_config v2 - -(** Test serialize/deserialize evaluation configuration and compare trees. *) let test_config_tree = test_generic_tree - ~evaluate:config_evaluate ~pp:Ast_printer.pp_config ~gen:Ast_generators.config_gen ~encoding:Wasm_encoding.config_encoding diff --git a/src/lib_scoru_wasm/wasm_encoding.ml b/src/lib_scoru_wasm/wasm_encoding.ml index 9b8d6847295a..119a3617157a 100644 --- a/src/lib_scoru_wasm/wasm_encoding.ml +++ b/src/lib_scoru_wasm/wasm_encoding.ml @@ -838,23 +838,17 @@ let input_buffer_encoding = input_buffer_message_encoding)) (value ["num-messages"] Data_encoding.z)) -module Output_bufferMap = Lazy_map_encoding.Make (Output_buffer.Map.Map) - -let output_content_encoding = +let index_vector_encoding = conv - Output_buffer.Map.of_immutable - Output_buffer.Map.snapshot - (Output_bufferMap.lazy_map (value [] Data_encoding.bytes)) + (fun index -> Output_buffer.Index_Vector.of_immutable index) + (fun buffer -> Output_buffer.Index_Vector.snapshot buffer) + (z_lazy_vector (value [] Data_encoding.z) (value [] Data_encoding.bytes)) let output_buffer_encoding = conv - (fun (content, level, id) -> Output_buffer.{content; level; id}) - (fun Output_buffer.{content; level; id} -> (content, level, id)) - (tup3 - ~flatten:true - output_content_encoding - (value ["level"] Data_encoding.int32) - (value ["id"] Data_encoding.z)) + (fun output -> Output_buffer.Level_Vector.of_immutable output) + (fun buffer -> Output_buffer.Level_Vector.snapshot buffer) + (int32_lazy_vector (value [] Data_encoding.int32) index_vector_encoding) let config_encoding ~host_funcs = conv diff --git a/src/lib_webassembly/runtime/output_buffer.ml b/src/lib_webassembly/runtime/output_buffer.ml index 58350bf25fd2..67fd2d3e7d1d 100644 --- a/src/lib_webassembly/runtime/output_buffer.ml +++ b/src/lib_webassembly/runtime/output_buffer.ml @@ -5,36 +5,55 @@ type output_info = { exception Id_too_large -module OutputKey : Lazy_map.KeyS with type t = output_info = struct - type t = output_info +exception Empty_output - let compare {outbox_level = l1; message_index = i1} - {outbox_level = l2; message_index = i2} = - let c1 = compare l1 l2 in - if c1 = 0 then Z.compare i1 i2 else c1 +exception Invalid_level - let to_string {outbox_level; message_index} = - Format.sprintf - "Outboxlevel= %li; message_index=%s" - outbox_level - (Z.to_string message_index) -end +exception Invalid_id -module Map = Lazy_map.Mutable.Make (OutputKey) +module Index_Vector = Lazy_vector.Mutable.ZVector +module Level_Vector = Lazy_vector.Mutable.Int32Vector -type t = {content : bytes Map.t; mutable level : int32; mutable id : Z.t} +type t = bytes Index_Vector.t Level_Vector.t -let get_level output = output.level +let get_level output = Int32.pred (Level_Vector.num_elements output) -let get_id output = output.id +let get_id output = + let open Lwt.Syntax in + let level = get_level output in + if level = -1l then raise Empty_output + else + let* last = Level_Vector.(get level output) in + Lwt.return @@ (level, Z.pred (Index_Vector.num_elements last)) let set_level output level = - if level > output.level then ( - output.level <- level ; - output.id <- Z.zero) - -let increase_id output = - let id = Z.succ output.id in - if id > Z.of_int32 Int32.max_int then raise Id_too_large else output.id <- id - -let alloc () = {content = Map.create (); level = 0l; id = Z.zero} + Level_Vector.grow + ~default:(fun () -> Index_Vector.create Z.zero) + (Int32.sub level (get_level output)) + output + +let index_create a = + let init = Index_Vector.create Z.zero in + Index_Vector.cons a init ; + init + +let set_value output a = + let open Lwt.Syntax in + let* level, index = get_id output in + if level = -1l then Lwt.return @@ Level_Vector.cons (index_create a) output + else if Z.to_int32 index >= Int32.max_int then raise Id_too_large + else + let* last = Level_Vector.get level output in + Lwt.return @@ Index_Vector.grow ~default:(fun () -> a) Z.one last + +let get output level index = + let max_level = get_level output in + if level > max_level || level < 0l then raise Invalid_level + else + let open Lwt.Syntax in + let* index_vector = Level_Vector.get level output in + let max_index = Z.pred @@ Index_Vector.num_elements index_vector in + if index > max_index || index < Z.zero then raise Invalid_id + else Index_Vector.get index index_vector + +let alloc () = Level_Vector.create 0l -- GitLab