1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
open Tezos_scoru_wasm_helpers
open Tezos_scoru_wasm
open Wasm_pvm_state.Internal_state
open Pvm_instance
type phase = Decoding | Initialising | Linking | Evaluating | Padding
[@@deriving show {with_path = false}]
let run_loop_once f a =
Lwt_list.fold_left_s
f
a
[Decoding; Linking; Initialising; Evaluating; Padding]
(** do [f a] until [reboot] returns false *)
let rec do_while continue f a =
let open Lwt_syntax in
let* next = f a in
let* should_reboot = continue next in
if should_reboot then (do_while [@tailcall]) continue f next else return next
let run_loop ?(reboot = None) f a =
match reboot with
| None -> run_loop_once f a
| Some need_reboot -> do_while need_reboot (run_loop_once f) a
(** Predicate defining the different phases of an execution *)
let should_continue phase (pvm_state : pvm_state) =
let continue =
match (phase, pvm_state.tick_state) with
| Decoding, Snapshot -> true
| Initialising, Init _ -> true
| Linking, Link _ -> true
| Decoding, Decode _ -> true
| Evaluating, Eval _ when Wasm_vm.eval_has_finished pvm_state.tick_state ->
false
| Evaluating, Eval _ -> true
| Padding, Padding -> true
| _, _ -> false
in
Lwt.return continue
let finish_top_level_call_on_state pvm_state =
Wasm_vm.compute_step_many ~max_steps:Int64.max_int ~write_debug:Noop pvm_state
let execute_fast ~reveal_builtins pvm_state =
Wasm_fast_vm.compute_step_many
~reveal_builtins
~max_steps:Int64.max_int
~write_debug:Noop
pvm_state
let execute_on_state ~reveal_builtins phase state =
match state.tick_state with
| Stuck _ -> Lwt.return (state, 0L)
| _ ->
Wasm_vm.compute_step_many_until
~reveal_builtins
~max_steps:Int64.max_int
~write_debug:Wasm_utils.write_debug_on_stdout
(should_continue phase)
state
let run kernel k =
let open Lwt_syntax in
let* res =
Lwt_io.with_file ~mode:Lwt_io.Input kernel (fun channel ->
let* kernel = Lwt_io.read channel in
k kernel)
in
return res
let read_message name =
let open Tezt.Base in
let kernel_file =
project_root // Filename.dirname __FILE__ // "messages" // name
in
read_file kernel_file
let initial_boot_sector_from_kernel ?(max_tick = 1000000000000L) kernel =
let open Lwt_syntax in
let+ tree =
Wasm_utils.initial_tree
~version:V1
~ticks_per_snapshot:max_tick
~from_binary:true
kernel
in
tree
type input = File of string | Str of string
let read_input = function Str s -> s | File s -> read_message s
type message = Transfer of input | Other of input | Encoded of input
let encode_message = function
| Transfer s ->
Pvm_input_kind.(
Internal_for_tests.to_binary_input
(Internal Transfer)
(Some (read_input s)))
| Other s ->
Pvm_input_kind.(
Internal_for_tests.to_binary_input External (Some (read_input s)))
| Encoded s -> read_input s
let set_internal_message level counter message state =
let encoded_message = encode_message message in
Wasm_utils.Wasm.set_input_step
(Wasm_utils.input_info level counter)
encoded_message
state
let load_messages messages level tree =
let open Lwt_syntax in
let* tree =
Wasm_utils.set_inputs_step set_internal_message messages level tree
in
Wasm_utils.eval_to_snapshot ~max_steps:Int64.max_int ~write_debug:Noop tree