diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml index e5febe7ad15288f0c5368d9319b1427e263a121e..55e070aa8fd2a1a9e83ce4d3941817cf319ddc30 100644 --- a/src/lib_scoru_wasm/host_funcs.ml +++ b/src/lib_scoru_wasm/host_funcs.ml @@ -28,13 +28,22 @@ 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* {rtype; raw_level; message_counter; payload} = Input_buffer.dequeue input_buffer in + 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 +51,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 +60,17 @@ 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* () = Output_buffer.set_value output_buffer (Bytes.of_string payload) in + Lwt.return 0l + let read_input_type = let input_types = Types. @@ -78,7 +90,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 +103,7 @@ let read_input = let* x = aux_write_input_in_memory ~input_buffer + ~output_buffer ~module_inst ~rtype_offset ~level_offset @@ -101,17 +114,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 871a25802ddce0dd2edf2b549722e47224c2f562..1c6f0a21a005003dadc8581eb7b0768f3f81ffe8 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 36dd373df95f921633657e5011168e10c5b8c3c1..f7b7c3be3b5dcde4ad99c4614f805678b2fb07f8 100644 --- a/src/lib_scoru_wasm/test/ast_generators.ml +++ b/src/lib_scoru_wasm/test/ast_generators.ml @@ -594,10 +594,35 @@ 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* l = small_list int in + 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.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 = + 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; 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 caf4af331409429ba2025d78c0aa3949373228fc..44fa6a3778c18df1d74234fea51fa2ec885921a0 100644 --- a/src/lib_scoru_wasm/test/ast_printer.ml +++ b/src/lib_scoru_wasm/test/ast_printer.ml @@ -626,12 +626,27 @@ 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) = + Format.fprintf + out + "@[%a@]" + (pp_vector (fun o -> pp_index_vector o)) + (Output_buffer.Level_Vector.snapshot output) + 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 +655,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 b285018a1db8babb3d6861aa7e4c27c8a85b718d..410ae79da4ddb56a925e9aa989119a2ba07d66e5 100644 --- a/src/lib_scoru_wasm/test/test_input.ml +++ b/src/lib_scoru_wasm/test/test_input.ml @@ -83,6 +83,7 @@ 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 let* () = Input_buffer.enqueue input_buffer @@ -104,6 +105,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 +116,9 @@ let read_input () = let* memory = Tezos_webassembly_interpreter.Instance.Vector.get 0l module_inst.memories in + let* output_level, output_id = Output_buffer.get_id output_buffer in + assert (output_level = 2l) ; + 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 @@ -364,6 +369,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 0000000000000000000000000000000000000000..33682f41fb6dd604b36a233393ccc69f7020f5e2 --- /dev/null +++ b/src/lib_scoru_wasm/test/test_output.ml @@ -0,0 +1,176 @@ +(*****************************************************************************) +(* *) +(* 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.get output_buffer 2l Z.zero in + assert (result = 0l) ; + 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 + +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.Int32Vector.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.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 (level = 2l) ; + assert (id = Z.zero) ; + 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 + let* level, id = Output_buffer.get_id output in + assert (result = Values.[Num (I32 1l)]) ; + assert (level = 2l) ; + assert (id = Z.zero) ; + 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 f4697d6eb4f82b7c6eb6ccb0010470b70a98a24d..89e4d0e95a9acca5a6a7a97a8260319be08c7771 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 17b96a80c9374f3d804c7348757a387dd3ee5bc2..3df7f675148eefa7908471b7156b3d452e4f4af1 100644 --- a/src/lib_scoru_wasm/test/test_wasm_encoding.ml +++ b/src/lib_scoru_wasm/test/test_wasm_encoding.ml @@ -126,7 +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 = +let test_generic_tree ~pp ~gen ~encoding () = let print = Format.asprintf "%a" pp in let open Lwt_result_syntax in let dummy_module_reg = @@ -152,7 +152,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 +160,28 @@ 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) +(** Test serialize/deserialize output buffers and compare trees. *) +let test_output_buffer_tree = + test_generic_tree + ~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,15 +189,14 @@ 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) -(** Test serialize/deserialize evaluation configuration and compare trees. *) -let test_config_tree () = +let test_config_tree = test_generic_tree ~pp:Ast_printer.pp_config ~gen:Ast_generators.config_gen @@ -204,6 +210,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 44b1522a65ff2d424bb1e0dfe9ba124ad9b3a6ef..119a3617157a2b669c74bf2bbf468041664b2340 100644 --- a/src/lib_scoru_wasm/wasm_encoding.ml +++ b/src/lib_scoru_wasm/wasm_encoding.ml @@ -838,16 +838,29 @@ let input_buffer_encoding = input_buffer_message_encoding)) (value ["num-messages"] Data_encoding.z)) +let index_vector_encoding = + conv + (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 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 - (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 4cea6efaae5ecab512c4733ff0c21e560651d0ff..8ee4913461d1bf43f01c64d35ae2e467ca893cc5 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 460ef5ca4531a29fd719ee957de5130da9ab9f11..086c2eca8a1148dbf4601247021e011249ca4146 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 251efcc959b6678e7cedc9862d04fa7494872c7a..b4bd5845e29779d8343b299d21058ddecc13bcd7 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 cb303c32eca7be1e7c8ec3a9f42a17a0547e22c6..1f44dd990a9feca8b9ed6d086da83fe735ebf391 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 8e93f8562f687568764c19e3b4108d547c5ec73a..595e77559e3f091dc95446263e14bfef8b078d86 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 d459ccb9406389da7688e769ce0711b3af4dd4fa..42c8770d867eef73beb62cb20d74fa4ec95dbe2d 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 75ae6720d5e7715d65ca55eb56a91c772e924cf3..23e257e6e6dd901ea2b5ff4659fedce8f1e87447 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 c50ebe848d39d46a7358e1c9484a861d10f43c2c..6ac460e4475feb544cfa1070991a6c249cd0380b 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 0000000000000000000000000000000000000000..67fd2d3e7d1da302f8242335962ed62c0f79e689 --- /dev/null +++ b/src/lib_webassembly/runtime/output_buffer.ml @@ -0,0 +1,59 @@ +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 + +exception Empty_output + +exception Invalid_level + +exception Invalid_id + +module Index_Vector = Lazy_vector.Mutable.ZVector +module Level_Vector = Lazy_vector.Mutable.Int32Vector + +type t = bytes Index_Vector.t Level_Vector.t + +let get_level output = Int32.pred (Level_Vector.num_elements output) + +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 = + 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