diff --git a/src/lib_scoru_wasm/durable.ml b/src/lib_scoru_wasm/durable.ml index 76833e6ddfc2026134dd802d49e0a9aa3db62620..66f39e44d15ad478102fe118272b05ef7cb7dff9 100644 --- a/src/lib_scoru_wasm/durable.ml +++ b/src/lib_scoru_wasm/durable.ml @@ -26,6 +26,7 @@ module T = Tree_encoding.Wrapped module Runner = Tree_encoding.Runner.Make (Tree_encoding.Wrapped) module E = Tree_encoding +module Storage = Tezos_webassembly_interpreter.Durable_storage type t = T.tree @@ -33,11 +34,16 @@ exception Invalid_key of string exception Not_found +exception Durable_empty + let encoding = E.wrapped_tree -let of_tree = T.select +let of_storage ~default s = + match Storage.to_tree s with Some t -> T.select t | None -> default + +let of_storage_exn s = T.select @@ Storage.to_tree_exn s -let to_tree = T.wrap +let to_storage d = Storage.of_tree @@ T.wrap d type key = string list diff --git a/src/lib_scoru_wasm/durable.mli b/src/lib_scoru_wasm/durable.mli index 941d19a4d6337c36b47939b9a71d52a3d75645ea..8a8400b8bd8dd41efe9e2d3c77345073a9049fd5 100644 --- a/src/lib_scoru_wasm/durable.mli +++ b/src/lib_scoru_wasm/durable.mli @@ -33,12 +33,19 @@ exception Invalid_key of string (** A value was not found in the durable store. *) exception Not_found +(** [Durable_storage.t] was empty. *) +exception Durable_empty + (** [encoding] is a [Tree_encoding] for [t]. *) val encoding : t Tree_encoding.t -val of_tree : Lazy_containers.Lazy_map.tree -> t +val of_storage : + default:t -> Tezos_webassembly_interpreter.Durable_storage.t -> t + +(** @raise Durable_empty *) +val of_storage_exn : Tezos_webassembly_interpreter.Durable_storage.t -> t -val to_tree : t -> Lazy_containers.Lazy_map.tree +val to_storage : t -> Tezos_webassembly_interpreter.Durable_storage.t (** [key] is the type that indexes [t]. It enforces several constraints: - a key's length is bounded. diff --git a/src/lib_scoru_wasm/host_funcs.ml b/src/lib_scoru_wasm/host_funcs.ml index 98fe652b9e5ff9afc678f870ae375bec17a7038a..b210eeabfd6d0a39568447e28fa3591a96a25c33 100644 --- a/src/lib_scoru_wasm/host_funcs.ml +++ b/src/lib_scoru_wasm/host_funcs.ml @@ -97,7 +97,7 @@ let read_input_name = "tezos_read_input" let read_input = Host_funcs.Host_func - (fun input_buffer output_buffer memories inputs -> + (fun input_buffer output_buffer durable memories inputs -> let open Lwt.Syntax in match inputs with | [ @@ -119,7 +119,7 @@ let read_input = ~dst ~max_bytes in - Lwt.return [Values.(Num (I32 (I32.of_int_s x)))] + Lwt.return (durable, [Values.(Num (I32 (I32.of_int_s x)))]) | _ -> raise Bad_input) let write_output_name = "tezos_write_output" @@ -133,7 +133,7 @@ let write_output_type = let write_output = Host_funcs.Host_func - (fun input_buffer output_buffer memories inputs -> + (fun input_buffer output_buffer durable memories inputs -> let open Lwt.Syntax in match inputs with | [Values.(Num (I32 src)); Values.(Num (I32 num_bytes))] -> @@ -146,7 +146,7 @@ let write_output = ~src ~num_bytes in - Lwt.return [Values.(Num (I32 x))] + Lwt.return (durable, [Values.(Num (I32 x))]) | _ -> raise Bad_input) let lookup name = diff --git a/src/lib_scoru_wasm/test/test_durable_storage.ml b/src/lib_scoru_wasm/test/test_durable_storage.ml index 16eeeb8b9c6258abc01c93698daa70eb2981507a..24e85b22eb4e2d0298e695dd7abc85b8215869fe 100644 --- a/src/lib_scoru_wasm/test/test_durable_storage.ml +++ b/src/lib_scoru_wasm/test/test_durable_storage.ml @@ -26,7 +26,7 @@ (** Testing ------- Component: Lib_scoru_wasm durable - Invocation: dune exec src/lib_scoru_wasm/test/test_scoru_wasm.exe \ + Invocation: dune exec src/lib_scoru_wasm/test/test_scoru_wasm.exe \ -- test "Durable storage" Subject: Durable storage tests for the tezos-scoru-wasm library *) @@ -38,7 +38,7 @@ include Test_encodings_util module Wasm = Wasm_pvm.Make (Tree) module Wrapped_tree_runner = Tree_encoding.Runner.Make (Tree_encoding.Wrapped) -let wrap_as_durable tree = +let wrap_as_durable_storage tree = let open Lwt.Syntax in let* tree = Tree_encoding_runner.encode @@ -51,7 +51,8 @@ let wrap_as_durable tree = (Tree_encoding.scope ["durable"] Tree_encoding.wrapped_tree) tree in - Tree_encoding.Wrapped.wrap tree + Tezos_webassembly_interpreter.Durable_storage.of_tree + @@ Tree_encoding.Wrapped.wrap tree let assert_invalid_key run = let open Lwt_syntax in @@ -78,8 +79,8 @@ let test_durable_find_value () = value tree in - let* tree = wrap_as_durable tree in - let durable = Durable.of_tree tree in + let* tree = wrap_as_durable_storage tree in + let durable = Durable.of_storage_exn tree in let* r = Durable.find_value durable @@ Durable.key_of_string_exn "/hello/value" in diff --git a/src/lib_scoru_wasm/test/test_get_set.ml b/src/lib_scoru_wasm/test/test_get_set.ml index d977241b55477e83531ae3f7d1e1f27410826e28..98a5b0515612741280b565e69bb5058a635a62f8 100644 --- a/src/lib_scoru_wasm/test/test_get_set.ml +++ b/src/lib_scoru_wasm/test/test_get_set.ml @@ -1,7 +1,7 @@ (*****************************************************************************) (* *) (* Open Source License *) -(* Copyright (c) 2022 Trili Tech *) +(* Copyright (c) 2022 TriliTech *) (* *) (* Permission is hereby granted, free of charge, to any person obtaining a *) (* copy of this software and associated documentation files (the "Software"),*) diff --git a/src/lib_scoru_wasm/test/test_input.ml b/src/lib_scoru_wasm/test/test_input.ml index 826a4498b318bc463c97e749b102009ba688146c..ed8dba3731a35cff6b1523f21186498f855baed6 100644 --- a/src/lib_scoru_wasm/test/test_input.ml +++ b/src/lib_scoru_wasm/test/test_input.ml @@ -176,7 +176,7 @@ let test_host_fun () = let module_key = Instance.Module_key "test" in Instance.update_module_ref module_reg module_key module_inst ; - let* result = + let* _, result = Eval.invoke ~module_reg ~caller:module_key diff --git a/src/lib_scoru_wasm/test/test_output.ml b/src/lib_scoru_wasm/test/test_output.ml index 3d5a5b602452496bba6295bc74c0f4abacf79064..02d02a0827dfbbd1a4ba34050fe16de164fbf102 100644 --- a/src/lib_scoru_wasm/test/test_output.ml +++ b/src/lib_scoru_wasm/test/test_output.ml @@ -129,7 +129,7 @@ let test_write_host_fun () = in let values = Values.[Num (I32 50l); Num (I32 5l)] in - let* result = + let* _, result = Eval.invoke ~module_reg ~caller:module_key @@ -146,7 +146,7 @@ let test_write_host_fun () = assert (level = 2l) ; assert (id = Z.zero) ; let values = Values.[Num (I32 50l); Num (I32 5000l)] in - let* result = + let* _, result = Eval.invoke ~module_reg ~caller:module_key diff --git a/src/lib_scoru_wasm/wasm_pvm.ml b/src/lib_scoru_wasm/wasm_pvm.ml index be33dbea6152ac70490f647811afb37ff9dca6ce..b321be6f700563089768ab4f75866fe99274b53e 100644 --- a/src/lib_scoru_wasm/wasm_pvm.ml +++ b/src/lib_scoru_wasm/wasm_pvm.ml @@ -172,11 +172,11 @@ struct let self = Wasm.Instance.Module_key wasm_main_module_name in (* The module instance is registered in [self] that contains the module registry, why we can ignore the result here. *) - Lwt.return (Init {self; ast_module; init_kont = IK_Start}) + Lwt.return (durable, Init {self; ast_module; init_kont = IK_Start}) | Decode m -> let* kernel = Durable.find_value_exn durable kernel_key in let+ m = Tezos_webassembly_interpreter.Decode.module_step kernel m in - Decode m + (durable, Decode m) | Init {self; ast_module = _; init_kont = IK_Stop _module_inst} -> ( let* module_inst = Wasm.Instance.ModuleMap.get wasm_main_module_name module_reg @@ -204,14 +204,15 @@ struct (Lazy_containers.Lazy_vector.Int32Vector.singleton admin_instr) in - Lwt.return (Eval eval_config) + Lwt.return (durable, 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")) - ) + ( durable, + Stuck + (Invalid_state "Invalid_module: no `main` function exported") + )) | Init {self; ast_module; init_kont} -> (* TODO: https://gitlab.com/tezos/tezos/-/issues/3786 Tickify linking, which implies taking care of Utf8 decoding *) @@ -247,11 +248,15 @@ struct externs init_kont in - Lwt.return (Init {self; ast_module; init_kont}) + Lwt.return (durable, Init {self; ast_module; init_kont}) | Eval eval_config -> - let+ eval_config = Wasm.Eval.step module_reg eval_config in - Eval eval_config - | Stuck e -> Lwt.return (Stuck e) + let store = Durable.to_storage durable in + let+ store', eval_config = + Wasm.Eval.step ~durable:store module_reg eval_config + in + let durable' = Durable.of_storage ~default:durable store' in + (durable', Eval eval_config) + | Stuck e -> Lwt.return (durable, Stuck e) let next_tick_state pvm_state = let to_stuck exn = @@ -266,7 +271,7 @@ struct | Stuck _ -> Unknown_error error.raw_exception) | `Unknown raw_exception -> Unknown_error raw_exception in - Lwt.return (Stuck wasm_error) + Lwt.return (pvm_state.durable, Stuck wasm_error) in Lwt.catch (fun () -> unsafe_next_tick_state pvm_state) to_stuck @@ -274,7 +279,7 @@ struct let open Lwt_syntax in 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* durable, tick_state = next_tick_state pvm_state in let input_request, tick_state = match tick_state with | Eval {step_kont = Wasm.Eval.(SK_Result _); _} -> @@ -292,13 +297,15 @@ struct | 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 *) + (* Update the tick state, input-request, durable and increment the + current tick *) let pvm_state = { pvm_state with tick_state; input_request; current_tick = Z.succ pvm_state.current_tick; + durable; } in diff --git a/src/lib_webassembly/bin/script/run.ml b/src/lib_webassembly/bin/script/run.ml index dc0d40dccfb4a5f0380e0760e34703e797444a01..e08e26fee9a1a0a2dc5e539506f064c04894a9f5 100644 --- a/src/lib_webassembly/bin/script/run.ml +++ b/src/lib_webassembly/bin/script/run.ml @@ -402,7 +402,7 @@ let run_action act : Values.value list Lwt.t = Script.error v.at "wrong type of argument") vs ins_l ; - let+ result = + let+ _, result = Eval.invoke ~module_reg:instances ~caller:(Module_key "__empty") diff --git a/src/lib_webassembly/exec/eval.ml b/src/lib_webassembly/exec/eval.ml index 22bab100ab8f342607f5b70841b57e5e7a91330f..a412cb0c0a9b2ddc7c2615173c4a9c2f281b1bfc 100644 --- a/src/lib_webassembly/exec/eval.ml +++ b/src/lib_webassembly/exec/eval.ml @@ -320,7 +320,8 @@ let block_type inst bt = let vmtake n vs = match n with Some n -> Vector.split vs n |> fst | None -> vs -let invoke_step (module_reg : module_reg) c frame at = function +let invoke_step ?(durable = Durable_storage.empty) (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 @@ -331,16 +332,17 @@ let invoke_step (module_reg : module_reg) c frame at = function 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; - }) + ( durable, + 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 () -> @@ -349,9 +351,11 @@ let invoke_step (module_reg : module_reg) c frame at = function 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+ durable, res = + f c.input c.output durable inst.memories (List.rev args) + in let vs' = Vector.prepend_list res vs' in - Inv_stop {code = (vs', es); fresh_frame = None}) + (durable, Inv_stop {code = (vs', es); fresh_frame = None})) (function Crash (_, msg) -> Crash.error at msg | exn -> raise exn)) | Inv_prepare_locals { @@ -365,38 +369,41 @@ let invoke_step (module_reg : module_reg) c frame at = function } 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; - }) + ( durable, + 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} + ( durable, + 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; - }) + ( durable, + 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} + (durable, Inv_prepare_args {tick with args_kont}) | Inv_concat { arity = n2; @@ -409,30 +416,31 @@ let invoke_step (module_reg : module_reg) c frame at = function 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) ); - }; - }; - }) + ( durable, + 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} + (durable, Inv_concat {tick with concat_kont}) (* Evaluation *) @@ -1224,8 +1232,13 @@ let step_instr module_reg label vs at e' es_rst stack : 'a label_kont Lwt.t = 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 -> + Durable_storage.t -> + module_reg -> + config -> + frame -> + label_step_kont -> + (Durable_storage.t * label_step_kont) Lwt.t = + fun durable module_reg c frame label_kont -> match label_kont with | LS_Push_frame _ | LS_Modify_top _ -> assert false | LS_Start (Label_stack (label, stack)) -> @@ -1233,161 +1246,182 @@ let label_step : 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* block = Vector.get b inst.allocations.blocks in - let length = Vector.num_elements block in - if i = length then + let+ kont = + 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* block = Vector.get b inst.allocations.blocks in + let length = Vector.num_elements block in + if i = length then + Lwt.return + (LS_Modify_top + (Label_stack ({label with label_code = (vs, es)}, stack))) + else + 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 (LS_Modify_top - (Label_stack ({label with label_code = (vs, es)}, stack))) - else - let+ instr = Vector.get i block in + (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' with label_code = - ( vs, - Vector.prepend_list - [ - Plain instr.it @@ instr.at; - From_block (Block_label b, Int32.succ i) @@ e.at; - ] - es ); + ( vs', + Vector.cons + (Breaking (Int32.pred k, vs0) @@ e.at) + es' ); }, stack )) - | Refer r -> - Lwt.return - (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 - (LS_Craft_frame - (Label_stack (label, stack), Inv_start {func; code = (vs, es)})) + | Invoke func -> + Lwt.return + (LS_Craft_frame + ( Label_stack (label, stack), + Inv_start {func; code = (vs, es)} )) + in + (durable, kont) else if Vector.num_elements stack = 0l then - Lwt.return (LS_Modify_top (Label_result vs)) + Lwt.return (durable, 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) + (durable, 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))) + ( durable, + 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) + (durable, 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) + ( durable, + 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+ durable, istep = + invoke_step ~durable module_reg c frame no_region istep + in + (durable, LS_Craft_frame (label, istep)) -let frame_step module_reg c = function +let frame_step durable 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 - 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_Start (frame, stack) -> + let+ kont = + 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 + 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)) + in + (durable, kont) | 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)) + Lwt.return + (durable, 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) + ( durable, + 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)) + Lwt.return (durable, 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)) + Lwt.return (durable, 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+ durable, istep = + label_step durable module_reg c frame.frame_specs istep + in + (durable, SK_Next (frame, stack, istep)) -let step module_reg c = +let step ?(durable = Durable_storage.empty) 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+ durable, step_kont = frame_step durable module_reg c kont in + (durable, {c with step_kont}) -let rec eval module_reg (c : config) : value list Lwt.t = +let rec eval durable module_reg (c : config) : + (Durable_storage.t * value list) Lwt.t = match c.step_kont with - | SK_Result vs -> Vector.to_list vs + | SK_Result vs -> + let+ values = Vector.to_list vs in + (durable, values) | SK_Trapped {it = msg; at} -> Trap.error at msg | _ -> - let* c = step module_reg c in - eval module_reg c + let* durable, c = step ~durable module_reg c in + eval durable module_reg c (* Functions & Constants *) 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 = + ?(output = Output_buffer.alloc ()) ?(durable = Durable_storage.empty) + host_funcs (func : func_inst) (vs : value list) : + (Durable_storage.t * 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 @@ -1416,8 +1450,8 @@ let invoke ~module_reg ~caller ?(input = Input_buffer.alloc ()) in Lwt.catch (fun () -> - let+ values = eval module_reg c in - List.rev values) + let+ durable, values = eval durable module_reg c in + (durable, List.rev values)) (function | Stack_overflow -> Exhaustion.error at "call stack exhausted" | exn -> Lwt.fail exn) @@ -1443,7 +1477,7 @@ let eval_const_step module_reg = function 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 + let+ _, c = step module_reg c in EC_Next c | EC_Stop _ -> assert false @@ -1979,7 +2013,7 @@ let init_step ?(check_module_exports = No_memory_export_rules) ~module_reg ~self Lwt.return (IK_Stop inst) | IK_Eval (_, {step_kont = SK_Trapped {it = msg; at}; _}) -> Trap.error at msg | IK_Eval (inst, config) -> - let+ config = step module_reg config in + let+ _, config = step module_reg config in IK_Eval (inst, config) | IK_Stop _ -> raise (Init_step_error Init_step) diff --git a/src/lib_webassembly/exec/eval.mli b/src/lib_webassembly/exec/eval.mli index 865f9f4e20dc20a6d83aaf5fd3a27d9765d42a9f..0f8888dd4c8cb3034a396a0037c942ef4dab4f16 100644 --- a/src/lib_webassembly/exec/eval.mli +++ b/src/lib_webassembly/exec/eval.mli @@ -235,12 +235,17 @@ val invoke : caller:module_key -> ?input:Input_buffer.t -> ?output:Output_buffer.t -> + ?durable:Durable_storage.t -> Host_funcs.registry -> func_inst -> value list -> - value list Lwt.t (* raises Trap *) + (Durable_storage.t * value list) Lwt.t (* raises Trap *) -val step : module_reg -> config -> config Lwt.t +val step : + ?durable:Durable_storage.t -> + module_reg -> + config -> + (Durable_storage.t * config) Lwt.t val config : ?input:input_inst -> diff --git a/src/lib_webassembly/host/env.ml b/src/lib_webassembly/host/env.ml index 1f44dd990a9feca8b9ed6d086da83fe735ebf391..be537b47d258447b19d553017fb1a3a40a08f0c8 100644 --- a/src/lib_webassembly/host/env.ml +++ b/src/lib_webassembly/host/env.ml @@ -28,14 +28,14 @@ let int = function let abort = Host_funcs.Host_func - (fun _input _output _mod_inst vs -> + (fun _input _output _durable _mod_inst vs -> empty vs ; print_endline "Abort!" ; exit (-1)) let exit = Host_funcs.Host_func - (fun _input _output _mod_inst vs -> exit (int (single vs))) + (fun _input _output _durable _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 595e77559e3f091dc95446263e14bfef8b078d86..84c2c56666b1972fcb1caf61108224782e10a6f7 100644 --- a/src/lib_webassembly/host/spectest.ml +++ b/src/lib_webassembly/host/spectest.ml @@ -34,10 +34,10 @@ let print_value v = let print = Host_funcs.Host_func - (fun _i _o _m vs -> + (fun _i _o d _m vs -> List.iter print_value vs ; flush_all () ; - Lwt.return_nil) + Lwt.return (d, [])) let register_host_funcs registry = Host_funcs.register ~global_name:"spectest_print" print registry ; diff --git a/src/lib_webassembly/runtime/durable_storage.ml b/src/lib_webassembly/runtime/durable_storage.ml new file mode 100644 index 0000000000000000000000000000000000000000..6ba37539b355245106d7d582623c415fa584e101 --- /dev/null +++ b/src/lib_webassembly/runtime/durable_storage.ml @@ -0,0 +1,11 @@ +type t = Lazy_containers.Lazy_map.tree option + +exception Durable_empty + +let of_tree tree = Some tree + +let to_tree_exn = function Some tree -> tree | None -> raise Durable_empty + +let to_tree t = t + +let empty = None diff --git a/src/lib_webassembly/runtime/durable_storage.mli b/src/lib_webassembly/runtime/durable_storage.mli new file mode 100644 index 0000000000000000000000000000000000000000..0ac980199aca0339f3bffcbdabf4cfda19d8a59d --- /dev/null +++ b/src/lib_webassembly/runtime/durable_storage.mli @@ -0,0 +1,13 @@ +(** The type of kernel's durable storage. *) +type t + +exception Durable_empty + +val empty : t + +val of_tree : Lazy_containers.Lazy_map.tree -> t + +(** @raise Durable_empty *) +val to_tree_exn : t -> Lazy_containers.Lazy_map.tree + +val to_tree : t -> Lazy_containers.Lazy_map.tree option diff --git a/src/lib_webassembly/runtime/host_funcs.ml b/src/lib_webassembly/runtime/host_funcs.ml index 4b679940818e117ca050ff211581b58a1cd2f8da..a4913c5dca8d0d610e0d29e51adf63b0c1ab4cdb 100644 --- a/src/lib_webassembly/runtime/host_funcs.ml +++ b/src/lib_webassembly/runtime/host_funcs.ml @@ -2,9 +2,10 @@ type host_func = | Host_func of (Input_buffer.t -> Output_buffer.t -> + Durable_storage.t -> Instance.memory_inst Instance.Vector.t -> Values.value list -> - Values.value list Lwt.t) + (Durable_storage.t * Values.value list) Lwt.t) [@@ocaml.unboxed] module Registry = Map.Make (String) diff --git a/src/lib_webassembly/runtime/host_funcs.mli b/src/lib_webassembly/runtime/host_funcs.mli index 29551eb5d2d1ad3edc8e4b62d8799f0ac8dd8d74..dd3b3eeedc3c3d88e660bd39fb93d8e976a0f399 100644 --- a/src/lib_webassembly/runtime/host_funcs.mli +++ b/src/lib_webassembly/runtime/host_funcs.mli @@ -3,9 +3,10 @@ type host_func = | Host_func of (Input_buffer.t -> Output_buffer.t -> + Durable_storage.t -> Instance.memory_inst Instance.Vector.t -> Values.value list -> - Values.value list Lwt.t) + (Durable_storage.t * Values.value list) Lwt.t) [@@ocaml.unboxed] (** A (mutable) host function registry *)