From 8a38c528feb82a8147bdbe5bcaae1ac282a6d260 Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Wed, 2 Jul 2025 12:15:26 +0200 Subject: [PATCH 1/4] Protocols: Remove profile_quebec.patch and update patch-profiler-proto.sh accordingly --- scripts/patch-profiler-proto.sh | 3 - scripts/profile_quebec.patch | 704 -------------------------------- 2 files changed, 707 deletions(-) delete mode 100644 scripts/profile_quebec.patch diff --git a/scripts/patch-profiler-proto.sh b/scripts/patch-profiler-proto.sh index d1aeaa8ab00d..f01fd1f3c3e9 100755 --- a/scripts/patch-profiler-proto.sh +++ b/scripts/patch-profiler-proto.sh @@ -14,9 +14,6 @@ for arg in "$@"; do esac done -#shellcheck disable=SC2086 -patch $dry_run -p 1 < scripts/profile_quebec.patch - #shellcheck disable=SC2086 patch $dry_run -p 1 < scripts/profile_riotuma.patch diff --git a/scripts/profile_quebec.patch b/scripts/profile_quebec.patch deleted file mode 100644 index b7c09f88d9e8..000000000000 --- a/scripts/profile_quebec.patch +++ /dev/null @@ -1,704 +0,0 @@ -From 7dd2d4003b39403c3e89973473392964f480eea6 Mon Sep 17 00:00:00 2001 -From: mattiasdrp -Date: Wed, 22 Jan 2025 17:38:32 +0100 -Subject: [PATCH] Protocol: Apply proto_alpha profiling previous commit to - proto_quebec - ---- - src/lib_protocol_environment/sigs/v13.in.ml | 2 + - src/lib_protocol_environment/sigs/v13.ml | 80 ++++++++++++++----- - .../sigs/v13/profiler.mli | 36 +++++++++ - src/proto_021_PsQuebec/lib_protocol/apply.ml | 17 ++-- - src/proto_021_PsQuebec/lib_protocol/baking.ml | 4 +- - .../lib_protocol/delegate_cycles.ml | 78 ++++++++++++++---- - src/proto_021_PsQuebec/lib_protocol/dune | 2 + - .../lib_protocol/init_storage.ml | 36 +++++++-- - .../lib_protocol/raw_context.ml | 13 +-- - .../lib_protocol/script_cache.ml | 19 ++--- - .../lib_protocol/script_interpreter.ml | 11 +-- - .../lib_protocol/script_ir_translator.ml | 40 +++++----- - 12 files changed, 253 insertions(+), 85 deletions(-) - create mode 100644 src/lib_protocol_environment/sigs/v13/profiler.mli - -diff --git a/src/lib_protocol_environment/sigs/v13.in.ml b/src/lib_protocol_environment/sigs/v13.in.ml -index af6bf60f3d1..d58e98487c5 100644 ---- a/src/lib_protocol_environment/sigs/v13.in.ml -+++ b/src/lib_protocol_environment/sigs/v13.in.ml -@@ -103,6 +103,8 @@ module type T = sig - - module Operation_list_list_hash : [%sig "v13/operation_list_list_hash.mli"] - -+ module Profiler : [%sig "v13/profiler.mli"] -+ - module Protocol_hash : [%sig "v13/protocol_hash.mli"] - - module Context_hash : [%sig "v13/context_hash.mli"] -diff --git a/src/lib_protocol_environment/sigs/v13.ml b/src/lib_protocol_environment/sigs/v13.ml -index c1f222ea45e..6f683e65b5d 100644 ---- a/src/lib_protocol_environment/sigs/v13.ml -+++ b/src/lib_protocol_environment/sigs/v13.ml -@@ -9962,6 +9962,48 @@ end - # 104 "v13.in.ml" - - -+ module Profiler : sig -+# 1 "v13/profiler.mli" -+(*****************************************************************************) -+(* *) -+(* SPDX-License-Identifier: MIT *) -+(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) -+(* *) -+(*****************************************************************************) -+ -+type metadata = (string * string) list -+ -+type id = string * metadata -+ -+type ids = string list * metadata -+ -+type verbosity = Notice | Info | Debug -+ -+val record : verbosity -> id -> unit -+ -+val record_f : verbosity -> id -> (unit -> 'a) -> 'a -+ -+val record_s : verbosity -> id -> (unit -> 'a Lwt.t) -> 'a Lwt.t -+ -+val aggregate : verbosity -> id -> unit -+ -+val aggregate_f : verbosity -> id -> (unit -> 'a) -> 'a -+ -+val aggregate_s : verbosity -> id -> (unit -> 'a Lwt.t) -> 'a Lwt.t -+ -+val span_f : verbosity -> ids -> (unit -> 'a) -> 'a -+ -+val span_s : verbosity -> ids -> (unit -> 'a Lwt.t) -> 'a Lwt.t -+ -+val stop : unit -> unit -+ -+val stamp : verbosity -> id -> unit -+ -+val mark : verbosity -> ids -> unit -+end -+# 106 "v13.in.ml" -+ -+ - module Protocol_hash : sig - # 1 "v13/protocol_hash.mli" - (*****************************************************************************) -@@ -9992,7 +10034,7 @@ end - (** Protocol hashes / IDs. *) - include S.HASH - end --# 106 "v13.in.ml" -+# 108 "v13.in.ml" - - - module Context_hash : sig -@@ -10045,7 +10087,7 @@ end - - type version = Version.t - end --# 108 "v13.in.ml" -+# 110 "v13.in.ml" - - - module Sapling : sig -@@ -10193,7 +10235,7 @@ module Verification : sig - val final_check : t -> UTXO.transaction -> string -> bool - end - end --# 110 "v13.in.ml" -+# 112 "v13.in.ml" - - - module Timelock : sig -@@ -10250,7 +10292,7 @@ val open_chest : chest -> chest_key -> time:int -> opening_result - Used for gas accounting*) - val get_plaintext_size : chest -> int - end --# 112 "v13.in.ml" -+# 114 "v13.in.ml" - - - module Vdf : sig -@@ -10338,7 +10380,7 @@ val prove : discriminant -> challenge -> difficulty -> result * proof - @raise Invalid_argument when inputs are invalid *) - val verify : discriminant -> challenge -> difficulty -> result -> proof -> bool - end --# 114 "v13.in.ml" -+# 116 "v13.in.ml" - - - module Micheline : sig -@@ -10398,7 +10440,7 @@ val annotations : ('l, 'p) node -> string list - - val strip_locations : (_, 'p) node -> 'p canonical - end --# 116 "v13.in.ml" -+# 118 "v13.in.ml" - - - module Block_header : sig -@@ -10455,7 +10497,7 @@ type t = {shell : shell_header; protocol_data : bytes} - - include S.HASHABLE with type t := t and type hash := Block_hash.t - end --# 118 "v13.in.ml" -+# 120 "v13.in.ml" - - - module Bounded : sig -@@ -10604,7 +10646,7 @@ module Int8 (B : BOUNDS with type ocaml_type := int) : - module Uint8 (B : BOUNDS with type ocaml_type := int) : - S with type ocaml_type := int - end --# 120 "v13.in.ml" -+# 122 "v13.in.ml" - - - module Fitness : sig -@@ -10638,7 +10680,7 @@ end - compared in a lexicographical order (longer list are greater). *) - include S.T with type t = bytes list - end --# 122 "v13.in.ml" -+# 124 "v13.in.ml" - - - module Operation : sig -@@ -10682,7 +10724,7 @@ type t = {shell : shell_header; proto : bytes} - - include S.HASHABLE with type t := t and type hash := Operation_hash.t - end --# 124 "v13.in.ml" -+# 126 "v13.in.ml" - - - module Context : sig -@@ -11319,7 +11361,7 @@ module Cache : - and type key = cache_key - and type value = cache_value - end --# 126 "v13.in.ml" -+# 128 "v13.in.ml" - - - module Updater : sig -@@ -11848,7 +11890,7 @@ end - not complete until [init] in invoked. *) - val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t - end --# 128 "v13.in.ml" -+# 130 "v13.in.ml" - - - module RPC_context : sig -@@ -12002,7 +12044,7 @@ val make_opt_call3 : - 'i -> - 'o option shell_tzresult Lwt.t - end --# 130 "v13.in.ml" -+# 132 "v13.in.ml" - - - module Context_binary : sig -@@ -12045,7 +12087,7 @@ module Tree : - - val make_empty_context : ?root:string -> unit -> t - end --# 132 "v13.in.ml" -+# 134 "v13.in.ml" - - - module Wasm_2_0_0 : sig -@@ -12119,7 +12161,7 @@ module Make - val get_info : Tree.tree -> info Lwt.t - end - end --# 134 "v13.in.ml" -+# 136 "v13.in.ml" - - - module Plonk : sig -@@ -12238,7 +12280,7 @@ val scalar_array_encoding : scalar array Data_encoding.t - on the given [inputs] according to the [public_parameters]. *) - val verify : public_parameters -> verifier_inputs -> proof -> bool - end --# 136 "v13.in.ml" -+# 138 "v13.in.ml" - - - module Dal : sig -@@ -12361,7 +12403,7 @@ val verify_page : - page_proof -> - (bool, [> `Segment_index_out_of_range | `Page_length_mismatch]) Result.t - end --# 138 "v13.in.ml" -+# 140 "v13.in.ml" - - - module Skip_list : sig -@@ -12593,7 +12635,7 @@ module Make (_ : sig - val basis : int - end) : S - end --# 140 "v13.in.ml" -+# 142 "v13.in.ml" - - - module Smart_rollup : sig -@@ -12650,6 +12692,6 @@ module Inbox_hash : S.HASH - (** Smart rollup merkelized payload hashes' hash *) - module Merkelized_payload_hashes_hash : S.HASH - end --# 142 "v13.in.ml" -+# 144 "v13.in.ml" - - end -diff --git a/src/lib_protocol_environment/sigs/v13/profiler.mli b/src/lib_protocol_environment/sigs/v13/profiler.mli -new file mode 100644 -index 00000000000..3dc7a1c702c ---- /dev/null -+++ b/src/lib_protocol_environment/sigs/v13/profiler.mli -@@ -0,0 +1,36 @@ -+(*****************************************************************************) -+(* *) -+(* SPDX-License-Identifier: MIT *) -+(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) -+(* *) -+(*****************************************************************************) -+ -+type metadata = (string * string) list -+ -+type id = string * metadata -+ -+type ids = string list * metadata -+ -+type verbosity = Notice | Info | Debug -+ -+val record : verbosity -> id -> unit -+ -+val record_f : verbosity -> id -> (unit -> 'a) -> 'a -+ -+val record_s : verbosity -> id -> (unit -> 'a Lwt.t) -> 'a Lwt.t -+ -+val aggregate : verbosity -> id -> unit -+ -+val aggregate_f : verbosity -> id -> (unit -> 'a) -> 'a -+ -+val aggregate_s : verbosity -> id -> (unit -> 'a Lwt.t) -> 'a Lwt.t -+ -+val span_f : verbosity -> ids -> (unit -> 'a) -> 'a -+ -+val span_s : verbosity -> ids -> (unit -> 'a Lwt.t) -> 'a Lwt.t -+ -+val stop : unit -> unit -+ -+val stamp : verbosity -> id -> unit -+ -+val mark : verbosity -> ids -> unit -diff --git a/src/proto_021_PsQuebec/lib_protocol/apply.ml b/src/proto_021_PsQuebec/lib_protocol/apply.ml -index 461cc5673b6..a949ea5e1cd 100644 ---- a/src/proto_021_PsQuebec/lib_protocol/apply.ml -+++ b/src/proto_021_PsQuebec/lib_protocol/apply.ml -@@ -2355,7 +2355,11 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode - ~source ~operation contents_list = - let open Lwt_result_syntax in - let ctxt = if mempool_mode then Gas.reset_block_gas ctxt else ctxt in -- let* ctxt, fees_updated_contents_list = take_fees ctxt contents_list in -+ let* ctxt, fees_updated_contents_list = -+ (take_fees -+ ctxt -+ contents_list [@profiler.record_s {verbosity = Notice} "take_fees"]) -+ in - let gas_cost_for_sig_check = - let algo = - Michelson_v1_gas.Cost_of.Interpreter.algo_of_public_key_hash source -@@ -2594,11 +2598,12 @@ let may_start_new_cycle ctxt = - match Level.dawn_of_a_new_cycle ctxt with - | None -> return (ctxt, [], []) - | Some last_cycle -> -- let* ctxt, balance_updates, deactivated = -- Delegate.cycle_end ctxt last_cycle -- in -- let+ ctxt = Bootstrap.cycle_end ctxt last_cycle in -- (ctxt, balance_updates, deactivated) -+ (let* ctxt, balance_updates, deactivated = -+ Delegate.cycle_end ctxt last_cycle -+ in -+ let+ ctxt = Bootstrap.cycle_end ctxt last_cycle in -+ (ctxt, balance_updates, deactivated)) -+ [@profiler.record_s {verbosity = Notice} "delegate end cycle"] - - let apply_liquidity_baking_subsidy ctxt ~per_block_vote = - let open Lwt_result_syntax in -diff --git a/src/proto_021_PsQuebec/lib_protocol/baking.ml b/src/proto_021_PsQuebec/lib_protocol/baking.ml -index 7cc21c60edc..23c4101cc4b 100644 ---- a/src/proto_021_PsQuebec/lib_protocol/baking.ml -+++ b/src/proto_021_PsQuebec/lib_protocol/baking.ml -@@ -83,7 +83,7 @@ type ordered_slots = { - let attesting_rights (ctxt : t) level = - let consensus_committee_size = Constants.consensus_committee_size ctxt in - let open Lwt_result_syntax in -- let*? slots = Slot.Range.create ~min:0 ~count:consensus_committee_size in -+ (let*? slots = Slot.Range.create ~min:0 ~count:consensus_committee_size in - Slot.Range.rev_fold_es - (fun (ctxt, map) slot -> - let* ctxt, consensus_pk = Stake_distribution.slot_owner ctxt level slot in -@@ -103,7 +103,7 @@ let attesting_rights (ctxt : t) level = - in - return (ctxt, map)) - (ctxt, Signature.Public_key_hash.Map.empty) -- slots -+ slots) [@profiler.record_s {verbosity = Notice} "attesting_rights_by_first_slot"] - - let attesting_rights_by_first_slot ctxt level = - let open Lwt_result_syntax in -diff --git a/src/proto_021_PsQuebec/lib_protocol/delegate_cycles.ml b/src/proto_021_PsQuebec/lib_protocol/delegate_cycles.ml -index 29813716743..d81af779b12 100644 ---- a/src/proto_021_PsQuebec/lib_protocol/delegate_cycles.ml -+++ b/src/proto_021_PsQuebec/lib_protocol/delegate_cycles.ml -@@ -197,18 +197,38 @@ let adjust_frozen_stakes ctxt ~deactivated_delegates : - let cycle_end ctxt last_cycle = - let open Lwt_result_syntax in - (* attributing attesting rewards *) -- let* ctxt, unrevealed_nonces = Seed_storage.cycle_end ctxt last_cycle in -+ let* ctxt, unrevealed_nonces = -+ (Seed_storage.cycle_end -+ ctxt -+ last_cycle -+ [@profiler.record_s {verbosity = Notice} "seed storage cycle end"]) -+ in - let* ctxt, attesting_balance_updates = -- distribute_attesting_rewards ctxt last_cycle unrevealed_nonces -+ (distribute_attesting_rewards -+ ctxt -+ last_cycle -+ unrevealed_nonces -+ [@profiler.record_s {verbosity = Notice} "distribute attesting rewards"]) - in - (* Applying slashing related to expiring denunciations *) - let* ctxt, slashing_balance_updates = -- Delegate_slashed_deposits_storage.apply_and_clear_denunciations ctxt -+ (Delegate_slashed_deposits_storage.apply_and_clear_denunciations -+ ctxt -+ [@profiler.record_s {verbosity = Notice} "apply and clear denunciations"]) - in - let new_cycle = Cycle_repr.add last_cycle 1 in -- let*! ctxt = Already_denounced_storage.clear_outdated_cycle ctxt ~new_cycle in -+ let*! ctxt = -+ (Already_denounced_storage.clear_outdated_cycle -+ ctxt -+ ~new_cycle -+ [@profiler.record_s {verbosity = Notice} "clear outdated cycle"]) -+ in - (* Deactivating delegates which didn't participate to consensus for too long *) -- let* ctxt, deactivated_delegates = update_activity ctxt last_cycle in -+ let* ctxt, deactivated_delegates = -+ (update_activity -+ ctxt -+ last_cycle [@profiler.record_s {verbosity = Notice} "update activity"]) -+ in - (* Applying autostaking. Do not move before slashing. Keep before rights - computation for optimising rights*) - let* ctxt, autostake_balance_updates = -@@ -218,25 +238,55 @@ let cycle_end ctxt last_cycle = - in - (* Computing future staking rights *) - let* ctxt = -- Delegate_sampler.select_new_distribution_at_cycle_end ctxt ~new_cycle -+ (Delegate_sampler.select_new_distribution_at_cycle_end -+ ctxt -+ ~new_cycle -+ [@profiler.record_s -+ {verbosity = Notice} "select new distribution at cycle end"]) - in - (* Activating consensus key for the cycle to come *) -- let*! ctxt = Delegate_consensus_key.activate ctxt ~new_cycle in -+ let*! ctxt = -+ (Delegate_consensus_key.activate -+ ctxt -+ ~new_cycle -+ [@profiler.record_s {verbosity = Notice} "activate consensus key"]) -+ in - (* trying to unforbid delegates for the cycle to come. *) - let* ctxt = -- Forbidden_delegates_storage.update_at_cycle_end_after_slashing -- ctxt -- ~new_cycle -+ (Forbidden_delegates_storage.update_at_cycle_end_after_slashing -+ ctxt -+ ~new_cycle -+ [@profiler.record_s -+ {verbosity = Notice} "update at cycle end after slashing"]) - in - (* clear deprecated cycles data. *) -- let* ctxt = Stake_storage.clear_at_cycle_end ctxt ~new_cycle in -- let* ctxt = Delegate_sampler.clear_outdated_sampling_data ctxt ~new_cycle in -+ let* ctxt = -+ (Stake_storage.clear_at_cycle_end -+ ctxt -+ ~new_cycle -+ [@profiler.record_s {verbosity = Notice} "clear stake storage"]) -+ in -+ let* ctxt = -+ (Delegate_sampler.clear_outdated_sampling_data -+ ctxt -+ ~new_cycle -+ [@profiler.record_s {verbosity = Notice} "clear outdated sampling data"]) -+ in - (* activate delegate parameters for the cycle to come. *) -- let*! ctxt = Delegate_staking_parameters.activate ctxt ~new_cycle in -+ let*! ctxt = -+ (Delegate_staking_parameters.activate -+ ctxt -+ ~new_cycle -+ [@profiler.record_s {verbosity = Notice} "activate staking parameters"]) -+ in - (* updating AI coefficient. It should remain after all balance changes of the - cycle-end operations *) - let* ctxt = -- Adaptive_issuance_storage.update_stored_rewards_at_cycle_end ctxt ~new_cycle -+ (Adaptive_issuance_storage.update_stored_rewards_at_cycle_end -+ ctxt -+ ~new_cycle -+ [@profiler.record_s -+ {verbosity = Notice} "update stored rewards at cycle end"]) - in - let balance_updates = - slashing_balance_updates @ attesting_balance_updates -diff --git a/src/proto_021_PsQuebec/lib_protocol/dune b/src/proto_021_PsQuebec/lib_protocol/dune -index 951ce3a6e17..53d0e6f7bed 100644 ---- a/src/proto_021_PsQuebec/lib_protocol/dune -+++ b/src/proto_021_PsQuebec/lib_protocol/dune -@@ -23,6 +23,8 @@ - (instrumentation (backend bisect_ppx)) - (libraries - tezos-protocol-021-PsQuebec.protocol.environment) -+ (preprocess (pps octez-libs.ppx_profiler)) -+ (preprocessor_deps (env_var TEZOS_PPX_PROFILER)) - (library_flags (:standard -linkall)) - (flags - (:standard) -diff --git a/src/proto_021_PsQuebec/lib_protocol/init_storage.ml b/src/proto_021_PsQuebec/lib_protocol/init_storage.ml -index db6ea15c0d4..bfb9b8fa673 100644 ---- a/src/proto_021_PsQuebec/lib_protocol/init_storage.ml -+++ b/src/proto_021_PsQuebec/lib_protocol/init_storage.ml -@@ -198,11 +198,19 @@ let prepare_first_block chain_id ctxt ~typecheck_smart_contract - (* Start of Quebec stitching. Comment used for automatic snapshot *) - | Quebec -> - let* ctxt = -- Storage.Tenderbake.First_level_of_protocol.update ctxt level -+ (Storage.Tenderbake.First_level_of_protocol.update -+ ctxt -+ level -+ [@profiler.record_s -+ {verbosity = Notice} "Tenderbake.First_level_of_protocol.update"]) - in - (* Migration of refutation games needs to be kept for each protocol. *) - let* ctxt = -- Sc_rollup_refutation_storage.migrate_clean_refutation_games ctxt -+ (Sc_rollup_refutation_storage.migrate_clean_refutation_games -+ ctxt -+ [@profiler.record_s -+ {verbosity = Notice} -+ "Sc_rollup_refutation_storage.migrate_clean_refutation_games"]) - in - return (ctxt, []) - (* End of Quebec stitching. Comment used for automatic snapshot *) -@@ -215,21 +223,37 @@ let prepare_first_block chain_id ctxt ~typecheck_smart_contract - /!\ this storage is also use to add the smart rollup - inbox migration message. see `sc_rollup_inbox_storage`. *) - let* ctxt = -- Storage.Tenderbake.First_level_of_protocol.update ctxt level -+ (Storage.Tenderbake.First_level_of_protocol.update -+ ctxt -+ level -+ [@profiler.record_s -+ {verbosity = Notice} "Tenderbake.First_level_of_protocol.update"]) - in - (* Migration of refutation games needs to be kept for each protocol. *) - let* ctxt = -- Sc_rollup_refutation_storage.migrate_clean_refutation_games ctxt -+ (Sc_rollup_refutation_storage.migrate_clean_refutation_games -+ ctxt -+ [@profiler.record_s -+ {verbosity = Notice} -+ "Sc_rollup_refutation_storage.migrate_clean_refutation_games"]) - in - return (ctxt, []) - (* End of alpha predecessor stitching. Comment used for automatic snapshot *) - in - let* ctxt = -- List.fold_left_es patch_script ctxt Legacy_script_patches.addresses_to_patch -+ (List.fold_left_es -+ patch_script -+ ctxt -+ Legacy_script_patches.addresses_to_patch -+ [@profiler.record_s {verbosity = Notice} "patch_script"]) - in - let*? balance_updates = Receipt_repr.group_balance_updates balance_updates in - let*! ctxt = -- Storage.Pending_migration.Balance_updates.add ctxt balance_updates -+ (Storage.Pending_migration.Balance_updates.add -+ ctxt -+ balance_updates -+ [@profiler.record_s -+ {verbosity = Notice} "Storage.Pending_migration.Balance_updates.add"]) - in - if Constants_storage.adaptive_issuance_force_activation ctxt then - let ctxt = Raw_context.set_adaptive_issuance_enable ctxt in -diff --git a/src/proto_021_PsQuebec/lib_protocol/raw_context.ml b/src/proto_021_PsQuebec/lib_protocol/raw_context.ml -index 9358b5181dc..da6fd2aa181 100644 ---- a/src/proto_021_PsQuebec/lib_protocol/raw_context.ml -+++ b/src/proto_021_PsQuebec/lib_protocol/raw_context.ml -@@ -1529,12 +1529,13 @@ let prepare_first_block ~level ~timestamp _chain_id ctxt = - (* End of beta predecessor stitching. Comment used for automatic snapshot *) - in - let+ ctxt = -- prepare -- ctxt -- ~level -- ~predecessor_timestamp:timestamp -- ~timestamp -- ~adaptive_issuance_enable:false -+ (prepare -+ ctxt -+ ~level -+ ~predecessor_timestamp:timestamp -+ ~timestamp -+ ~adaptive_issuance_enable:false -+ [@profiler.record_s {verbosity = Notice} "Prepare"]) - in - (previous_proto, previous_proto_constants, ctxt) - -diff --git a/src/proto_021_PsQuebec/lib_protocol/script_cache.ml b/src/proto_021_PsQuebec/lib_protocol/script_cache.ml -index 70a79eb8f44..9724bc4246b 100644 ---- a/src/proto_021_PsQuebec/lib_protocol/script_cache.ml -+++ b/src/proto_021_PsQuebec/lib_protocol/script_cache.ml -@@ -98,15 +98,16 @@ let find ctxt addr = - | Some (unparsed_script, ex_script) -> - return (ctxt, identifier, Some (unparsed_script, ex_script)) - | None -> ( -- let* ctxt, result = load_and_elaborate ctxt addr in -- match result with -- | None -> return (ctxt, identifier, None) -- | Some (unparsed_script, script_ir, size) -> -- let cached_value = (unparsed_script, script_ir) in -- let*? ctxt = -- Cache.update ctxt identifier (Some (cached_value, size)) -- in -- return (ctxt, identifier, Some (unparsed_script, script_ir))) -+ (let* ctxt, result = load_and_elaborate ctxt addr in -+ match result with -+ | None -> return (ctxt, identifier, None) -+ | Some (unparsed_script, script_ir, size) -> -+ let cached_value = (unparsed_script, script_ir) in -+ let*? ctxt = -+ Cache.update ctxt identifier (Some (cached_value, size)) -+ in -+ return (ctxt, identifier, Some (unparsed_script, script_ir))) -+ [@profiler.record_s {verbosity = Notice} "cache_miss"]) - - let update ctxt identifier updated_script approx_size = - Cache.update ctxt identifier (Some (updated_script, approx_size)) -diff --git a/src/proto_021_PsQuebec/lib_protocol/script_interpreter.ml b/src/proto_021_PsQuebec/lib_protocol/script_interpreter.ml -index ff028667e60..6da6a5cce62 100644 ---- a/src/proto_021_PsQuebec/lib_protocol/script_interpreter.ml -+++ b/src/proto_021_PsQuebec/lib_protocol/script_interpreter.ml -@@ -1803,7 +1803,7 @@ type execution_result = { - let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal - unparsed_script cached_script arg = - let open Lwt_result_syntax in -- let elab_conf = -+ (let elab_conf = - Script_ir_translator_config.make - ~legacy:true - ~keep_extra_types_for_interpreter_logging:(Option.is_some logger) -@@ -1856,9 +1856,10 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal - Script_ir_translator.collect_lazy_storage ctxt storage_type old_storage - in - let* (ops, new_storage), ctxt = -- trace -- (Runtime_contract_error step_constants.self) -- (interp logger (ctxt, step_constants) code (arg, old_storage)) -+ (trace -+ (Runtime_contract_error step_constants.self) -+ (interp logger (ctxt, step_constants) code (arg, old_storage)) -+ [@profiler.record_s {verbosity = Notice} "interprete"]) - in - let* storage, lazy_storage_diff, ctxt = - Script_ir_translator.extract_lazy_storage_diff -@@ -1924,7 +1925,7 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal - ticket_diffs; - ticket_receipt; - }, -- ctxt ) -+ ctxt )) [@profiler.record_s {verbosity = Notice} "execute"] - - let execute_with_typed_parameter ?logger ctxt ~cached_script mode step_constants - ~script ~entrypoint ~parameter_ty ~location ~parameter ~internal = -diff --git a/src/proto_021_PsQuebec/lib_protocol/script_ir_translator.ml b/src/proto_021_PsQuebec/lib_protocol/script_ir_translator.ml -index 9041c1f66f8..d395af5f5aa 100644 ---- a/src/proto_021_PsQuebec/lib_protocol/script_ir_translator.ml -+++ b/src/proto_021_PsQuebec/lib_protocol/script_ir_translator.ml -@@ -5223,17 +5223,21 @@ let parse_script : - (Code - {code; arg_type; storage_type; views; entrypoints; code_size}), - ctxt ) = -- parse_code ~unparse_code_rec ~elab_conf ctxt ~code -+ (parse_code -+ ~unparse_code_rec -+ ~elab_conf -+ ctxt -+ ~code [@profiler.record_s {verbosity = Notice} "parse_code"]) - in - let+ storage, ctxt = -- parse_storage -- ~unparse_code_rec -- ~elab_conf -- ctxt -- ~allow_forged_tickets:allow_forged_tickets_in_storage -- ~allow_forged_lazy_storage_id:allow_forged_lazy_storage_id_in_storage -- storage_type -- ~storage -+ (parse_storage -+ ~unparse_code_rec -+ ~elab_conf -+ ctxt -+ ~allow_forged_tickets:allow_forged_tickets_in_storage -+ ~allow_forged_lazy_storage_id:allow_forged_lazy_storage_id_in_storage -+ storage_type -+ ~storage [@profiler.record_s {verbosity = Notice} "parse_storage"]) - in - ( Ex_script - (Script -@@ -5933,15 +5937,15 @@ let list_of_big_map_ids ids = - - let parse_data ~elab_conf ctxt ~allow_forged_tickets - ~allow_forged_lazy_storage_id ty t = -- parse_data -- ~unparse_code_rec -- ~elab_conf -- ~allow_forged_tickets -- ~allow_forged_lazy_storage_id -- ~stack_depth:0 -- ctxt -- ty -- t -+ (parse_data -+ ~unparse_code_rec -+ ~elab_conf -+ ~allow_forged_tickets -+ ~allow_forged_lazy_storage_id -+ ~stack_depth:0 -+ ctxt -+ ty -+ t [@profiler.record_s {verbosity = Notice} "parse_data"]) - - let parse_view ~elab_conf ctxt ty view = - parse_view ~unparse_code_rec ~elab_conf ctxt ty view --- -2.48.1 - -- GitLab From 1ab6037b17da31972379636bf3e26cd606e17e4d Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Wed, 2 Jul 2025 11:41:27 +0200 Subject: [PATCH 2/4] Protocols: Update proto_riotuma.patch --- scripts/profile_riotuma.patch | 154 +++++++++++++++++----------------- 1 file changed, 76 insertions(+), 78 deletions(-) diff --git a/scripts/profile_riotuma.patch b/scripts/profile_riotuma.patch index 63a057432c71..559b13eda054 100644 --- a/scripts/profile_riotuma.patch +++ b/scripts/profile_riotuma.patch @@ -1,8 +1,7 @@ -From 9c295853c8418576bd9a2eb5674d7c403a7726e9 Mon Sep 17 00:00:00 2001 +From 37749ee521eb4ce6354cba3d364578b39f15d9dc Mon Sep 17 00:00:00 2001 From: mattiasdrp -Date: Wed, 26 Feb 2025 13:52:26 +0100 -Subject: [PATCH] Protocol: Apply proto_alpha profiling previous commit to - proto_riotuma +Date: Wed, 2 Jul 2025 11:28:42 +0200 +Subject: [PATCH] Patch Riotuma --- src/lib_protocol_environment/sigs/v14.in.ml | 2 + @@ -21,26 +20,26 @@ Subject: [PATCH] Protocol: Apply proto_alpha profiling previous commit to create mode 100644 src/lib_protocol_environment/sigs/v14/profiler.mli diff --git a/src/lib_protocol_environment/sigs/v14.in.ml b/src/lib_protocol_environment/sigs/v14.in.ml -index 03049abae6e..e15b4967c1e 100644 +index 03049abae6..e15b4967c1 100644 --- a/src/lib_protocol_environment/sigs/v14.in.ml +++ b/src/lib_protocol_environment/sigs/v14.in.ml @@ -105,6 +105,8 @@ module type T = sig - + module Operation_list_list_hash : [%sig "v14/operation_list_list_hash.mli"] - + + module Profiler : [%sig "v14/profiler.mli"] + module Protocol_hash : [%sig "v14/protocol_hash.mli"] - + module Context_hash : [%sig "v14/context_hash.mli"] diff --git a/src/lib_protocol_environment/sigs/v14.ml b/src/lib_protocol_environment/sigs/v14.ml -index 6ced2a63440..030da81181b 100644 +index 6ced2a6344..030da81181 100644 --- a/src/lib_protocol_environment/sigs/v14.ml +++ b/src/lib_protocol_environment/sigs/v14.ml @@ -10049,6 +10049,48 @@ end # 106 "v14.in.ml" - - + + + module Profiler : sig +# 1 "v14/profiler.mli" +(*****************************************************************************) @@ -92,17 +91,17 @@ index 6ced2a63440..030da81181b 100644 end -# 108 "v14.in.ml" +# 110 "v14.in.ml" - - + + module Context_hash : sig @@ -10132,7 +10174,7 @@ end - + type version = Version.t end -# 110 "v14.in.ml" +# 112 "v14.in.ml" - - + + module Sapling : sig @@ -10280,7 +10322,7 @@ module Verification : sig val final_check : t -> UTXO.transaction -> string -> bool @@ -110,8 +109,8 @@ index 6ced2a63440..030da81181b 100644 end -# 112 "v14.in.ml" +# 114 "v14.in.ml" - - + + module Timelock : sig @@ -10337,7 +10379,7 @@ val open_chest : chest -> chest_key -> time:int -> opening_result Used for gas accounting*) @@ -119,8 +118,8 @@ index 6ced2a63440..030da81181b 100644 end -# 114 "v14.in.ml" +# 116 "v14.in.ml" - - + + module Vdf : sig @@ -10425,7 +10467,7 @@ val prove : discriminant -> challenge -> difficulty -> result * proof @raise Invalid_argument when inputs are invalid *) @@ -128,26 +127,26 @@ index 6ced2a63440..030da81181b 100644 end -# 116 "v14.in.ml" +# 118 "v14.in.ml" - - + + module Micheline : sig @@ -10485,7 +10527,7 @@ val annotations : ('l, 'p) node -> string list - + val strip_locations : (_, 'p) node -> 'p canonical end -# 118 "v14.in.ml" +# 120 "v14.in.ml" - - + + module Block_header : sig @@ -10542,7 +10584,7 @@ type t = {shell : shell_header; protocol_data : bytes} - + include S.HASHABLE with type t := t and type hash := Block_hash.t end -# 120 "v14.in.ml" +# 122 "v14.in.ml" - - + + module Bounded : sig @@ -10691,7 +10733,7 @@ module Int8 (B : BOUNDS with type ocaml_type := int) : module Uint8 (B : BOUNDS with type ocaml_type := int) : @@ -155,8 +154,8 @@ index 6ced2a63440..030da81181b 100644 end -# 122 "v14.in.ml" +# 124 "v14.in.ml" - - + + module Fitness : sig @@ -10725,7 +10767,7 @@ end compared in a lexicographical order (longer list are greater). *) @@ -164,17 +163,17 @@ index 6ced2a63440..030da81181b 100644 end -# 124 "v14.in.ml" +# 126 "v14.in.ml" - - + + module Operation : sig @@ -10769,7 +10811,7 @@ type t = {shell : shell_header; proto : bytes} - + include S.HASHABLE with type t := t and type hash := Operation_hash.t end -# 126 "v14.in.ml" +# 128 "v14.in.ml" - - + + module Context : sig @@ -11406,7 +11448,7 @@ module Cache : and type key = cache_key @@ -182,8 +181,8 @@ index 6ced2a63440..030da81181b 100644 end -# 128 "v14.in.ml" +# 130 "v14.in.ml" - - + + module Updater : sig @@ -11935,7 +11977,7 @@ end not complete until [init] in invoked. *) @@ -191,8 +190,8 @@ index 6ced2a63440..030da81181b 100644 end -# 130 "v14.in.ml" +# 132 "v14.in.ml" - - + + module RPC_context : sig @@ -12089,7 +12131,7 @@ val make_opt_call3 : 'i -> @@ -200,17 +199,17 @@ index 6ced2a63440..030da81181b 100644 end -# 132 "v14.in.ml" +# 134 "v14.in.ml" - - + + module Context_binary : sig @@ -12132,7 +12174,7 @@ module Tree : - + val make_empty_context : ?root:string -> unit -> t end -# 134 "v14.in.ml" +# 136 "v14.in.ml" - - + + module Wasm_2_0_0 : sig @@ -12206,7 +12248,7 @@ module Make val get_info : Tree.tree -> info Lwt.t @@ -218,8 +217,8 @@ index 6ced2a63440..030da81181b 100644 end -# 136 "v14.in.ml" +# 138 "v14.in.ml" - - + + module Plonk : sig @@ -12325,7 +12367,7 @@ val scalar_array_encoding : scalar array Data_encoding.t on the given [inputs] according to the [public_parameters]. *) @@ -227,8 +226,8 @@ index 6ced2a63440..030da81181b 100644 end -# 138 "v14.in.ml" +# 140 "v14.in.ml" - - + + module Dal : sig @@ -12480,7 +12522,7 @@ val share_is_trap : traps_fraction:Q.t -> @@ -236,8 +235,8 @@ index 6ced2a63440..030da81181b 100644 end -# 140 "v14.in.ml" +# 142 "v14.in.ml" - - + + module Skip_list : sig @@ -12712,7 +12754,7 @@ module Make (_ : sig val basis : int @@ -245,8 +244,8 @@ index 6ced2a63440..030da81181b 100644 end -# 142 "v14.in.ml" +# 144 "v14.in.ml" - - + + module Smart_rollup : sig @@ -12769,6 +12811,6 @@ module Inbox_hash : S.HASH (** Smart rollup merkelized payload hashes' hash *) @@ -254,11 +253,11 @@ index 6ced2a63440..030da81181b 100644 end -# 144 "v14.in.ml" +# 146 "v14.in.ml" - + end diff --git a/src/lib_protocol_environment/sigs/v14/profiler.mli b/src/lib_protocol_environment/sigs/v14/profiler.mli new file mode 100644 -index 00000000000..3dc7a1c702c +index 0000000000..3dc7a1c702 --- /dev/null +++ b/src/lib_protocol_environment/sigs/v14/profiler.mli @@ -0,0 +1,36 @@ @@ -299,7 +298,7 @@ index 00000000000..3dc7a1c702c + +val mark : verbosity -> ids -> unit diff --git a/src/proto_022_PsRiotum/lib_protocol/apply.ml b/src/proto_022_PsRiotum/lib_protocol/apply.ml -index dea20068c27..d1c37ca6523 100644 +index dea20068c2..d1c37ca652 100644 --- a/src/proto_022_PsRiotum/lib_protocol/apply.ml +++ b/src/proto_022_PsRiotum/lib_protocol/apply.ml @@ -2377,7 +2377,11 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode @@ -330,11 +329,11 @@ index dea20068c27..d1c37ca6523 100644 + let+ ctxt = Bootstrap.cycle_end ctxt last_cycle in + (ctxt, balance_updates, deactivated)) + [@profiler.record_s {verbosity = Notice} "delegate end cycle"] - + let apply_liquidity_baking_subsidy ctxt ~per_block_vote = let open Lwt_result_syntax in diff --git a/src/proto_022_PsRiotum/lib_protocol/baking.ml b/src/proto_022_PsRiotum/lib_protocol/baking.ml -index 0af0632f22b..21716f27e31 100644 +index 0af0632f22..21716f27e3 100644 --- a/src/proto_022_PsRiotum/lib_protocol/baking.ml +++ b/src/proto_022_PsRiotum/lib_protocol/baking.ml @@ -84,7 +84,7 @@ type ordered_slots = { @@ -352,11 +351,11 @@ index 0af0632f22b..21716f27e31 100644 (ctxt, Signature.Public_key_hash.Map.empty) - slots + slots) [@profiler.record_s {verbosity = Notice} "attesting_rights_by_first_slot"] - + let attesting_rights_by_first_slot ctxt level = let open Lwt_result_syntax in diff --git a/src/proto_022_PsRiotum/lib_protocol/delegate_cycles.ml b/src/proto_022_PsRiotum/lib_protocol/delegate_cycles.ml -index db2bd663de9..61812537b09 100644 +index db2bd663de..61812537b0 100644 --- a/src/proto_022_PsRiotum/lib_protocol/delegate_cycles.ml +++ b/src/proto_022_PsRiotum/lib_protocol/delegate_cycles.ml @@ -208,42 +208,92 @@ let distribute_attesting_rewards ctxt last_cycle unrevealed_nonces = @@ -467,20 +466,20 @@ index db2bd663de9..61812537b09 100644 let balance_updates = slashing_balance_updates @ attesting_balance_updates in return (ctxt, balance_updates, deactivated_delegates) diff --git a/src/proto_022_PsRiotum/lib_protocol/dune b/src/proto_022_PsRiotum/lib_protocol/dune -index 778f72b6d65..393f8c54fc5 100644 +index 778f72b6d6..eb2155f2b0 100644 --- a/src/proto_022_PsRiotum/lib_protocol/dune +++ b/src/proto_022_PsRiotum/lib_protocol/dune -@@ -7,6 +7,8 @@ +@@ -23,6 +23,8 @@ (instrumentation (backend bisect_ppx)) (libraries - octez-proto-libs.protocol-environment) + tezos-protocol-022-PsRiotum.protocol.environment) + (preprocess (pps octez-libs.ppx_profiler)) + (preprocessor_deps (env_var TEZOS_PPX_PROFILER)) (library_flags (:standard -linkall)) - (modules Tezos_protocol_environment_022_PsRiotum)) - + (flags + (:standard) diff --git a/src/proto_022_PsRiotum/lib_protocol/init_storage.ml b/src/proto_022_PsRiotum/lib_protocol/init_storage.ml -index 9256e603aac..d9c45ba5738 100644 +index 9256e603aa..d9c45ba573 100644 --- a/src/proto_022_PsRiotum/lib_protocol/init_storage.ml +++ b/src/proto_022_PsRiotum/lib_protocol/init_storage.ml @@ -251,11 +251,19 @@ let prepare_first_block chain_id ctxt ~typecheck_smart_contract @@ -514,7 +513,7 @@ index 9256e603aac..d9c45ba5738 100644 + ctxt + level + [@profiler.record_s -+ +{verbosity = Notice} "Tenderbake.First_level_of_protocol.update"]) ++ {verbosity = Notice} "Tenderbake.First_level_of_protocol.update"]) in (* Migration of refutation games needs to be kept for each protocol. *) let* ctxt = @@ -549,7 +548,7 @@ index 9256e603aac..d9c45ba5738 100644 in return ctxt diff --git a/src/proto_022_PsRiotum/lib_protocol/raw_context.ml b/src/proto_022_PsRiotum/lib_protocol/raw_context.ml -index 85073bc8cb9..04d15bac5af 100644 +index 85073bc8cb..04d15bac5a 100644 --- a/src/proto_022_PsRiotum/lib_protocol/raw_context.ml +++ b/src/proto_022_PsRiotum/lib_protocol/raw_context.ml @@ -1610,12 +1610,13 @@ let prepare_first_block ~level ~timestamp chain_id ctxt = @@ -571,9 +570,9 @@ index 85073bc8cb9..04d15bac5af 100644 + [@profiler.record_s {verbosity = Notice} "Prepare"]) in (previous_proto, previous_proto_constants, ctxt) - + diff --git a/src/proto_022_PsRiotum/lib_protocol/script_cache.ml b/src/proto_022_PsRiotum/lib_protocol/script_cache.ml -index 70a79eb8f44..9724bc4246b 100644 +index 70a79eb8f4..9724bc4246 100644 --- a/src/proto_022_PsRiotum/lib_protocol/script_cache.ml +++ b/src/proto_022_PsRiotum/lib_protocol/script_cache.ml @@ -98,15 +98,16 @@ let find ctxt addr = @@ -599,11 +598,11 @@ index 70a79eb8f44..9724bc4246b 100644 + in + return (ctxt, identifier, Some (unparsed_script, script_ir))) + [@profiler.record_s {verbosity = Notice} "cache_miss"]) - + let update ctxt identifier updated_script approx_size = Cache.update ctxt identifier (Some (updated_script, approx_size)) diff --git a/src/proto_022_PsRiotum/lib_protocol/script_interpreter.ml b/src/proto_022_PsRiotum/lib_protocol/script_interpreter.ml -index ff028667e60..546d275f075 100644 +index ff028667e6..546d275f07 100644 --- a/src/proto_022_PsRiotum/lib_protocol/script_interpreter.ml +++ b/src/proto_022_PsRiotum/lib_protocol/script_interpreter.ml @@ -1856,9 +1856,10 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal @@ -626,11 +625,11 @@ index ff028667e60..546d275f075 100644 }, - ctxt ) + ctxt ) [@profiler.record_s {verbosity = Notice} "execute"] - + let execute_with_typed_parameter ?logger ctxt ~cached_script mode step_constants ~script ~entrypoint ~parameter_ty ~location ~parameter ~internal = diff --git a/src/proto_022_PsRiotum/lib_protocol/script_ir_translator.ml b/src/proto_022_PsRiotum/lib_protocol/script_ir_translator.ml -index 9041c1f66f8..d395af5f5aa 100644 +index 9041c1f66f..d395af5f5a 100644 --- a/src/proto_022_PsRiotum/lib_protocol/script_ir_translator.ml +++ b/src/proto_022_PsRiotum/lib_protocol/script_ir_translator.ml @@ -5223,17 +5223,21 @@ let parse_script : @@ -665,7 +664,7 @@ index 9041c1f66f8..d395af5f5aa 100644 ( Ex_script (Script @@ -5933,15 +5937,15 @@ let list_of_big_map_ids ids = - + let parse_data ~elab_conf ctxt ~allow_forged_tickets ~allow_forged_lazy_storage_id ty t = - parse_data @@ -686,9 +685,8 @@ index 9041c1f66f8..d395af5f5aa 100644 + ctxt + ty + t [@profiler.record_s {verbosity = Notice} "parse_data"]) - + let parse_view ~elab_conf ctxt ty view = parse_view ~unparse_code_rec ~elab_conf ctxt ty view --- -2.48.1 - +-- +2.50.0 -- GitLab From 83359154e1fd05ed99349ee035e1c229c0ec2d1a Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Wed, 2 Jul 2025 11:41:09 +0200 Subject: [PATCH 3/4] Protocols: Update proto_alpha.patch --- scripts/profile_alpha.patch | 122 ++++++++++++++++-------------------- 1 file changed, 54 insertions(+), 68 deletions(-) diff --git a/scripts/profile_alpha.patch b/scripts/profile_alpha.patch index ecb768676ad8..c1c154251162 100644 --- a/scripts/profile_alpha.patch +++ b/scripts/profile_alpha.patch @@ -1,20 +1,8 @@ -From e6e6af3232c9479b7f30678d38ef9079f9d76275 Mon Sep 17 00:00:00 2001 +From 48b33e443cd2a4fed3b16a34ef34e664be1d68a9 Mon Sep 17 00:00:00 2001 From: mattiasdrp -Date: Fri, 24 Jan 2025 16:10:40 +0100 -Subject: [PATCH] Protocol: Profile proto_alpha by using the already defined - headless backend +Date: Wed, 2 Jul 2025 11:29:00 +0200 +Subject: [PATCH] Patch alpha -The headless backend is defined in lib_shell/block_validator_process.ml - -When some functions finish, we gather the reports from the headless profiler -that contain profiling reports from spawned processes (otherwise, since the -profiling is made in a different process it would have been deleted when the -process ends). - -Another way to see this is to imagine that the process is spawned with a report -pipeline that belongs to the main process and writes all its reports in it. Once -it finishes, the main process checks if there are some reports in its pipelines -and handles them properly. --- src/lib_protocol_environment/sigs/v15.in.ml | 2 + src/lib_protocol_environment/sigs/v15.ml | 80 ++++++++++++++----- @@ -32,7 +20,7 @@ and handles them properly. create mode 100644 src/lib_protocol_environment/sigs/v15/profiler.mli diff --git a/src/lib_protocol_environment/sigs/v15.in.ml b/src/lib_protocol_environment/sigs/v15.in.ml -index a9820536d50..6c138493d79 100644 +index e86731c9cb..05291026e6 100644 --- a/src/lib_protocol_environment/sigs/v15.in.ml +++ b/src/lib_protocol_environment/sigs/v15.in.ml @@ -105,6 +105,8 @@ module type T = sig @@ -45,10 +33,10 @@ index a9820536d50..6c138493d79 100644 module Context_hash : [%sig "v15/context_hash.mli"] diff --git a/src/lib_protocol_environment/sigs/v15.ml b/src/lib_protocol_environment/sigs/v15.ml -index 973d4e40d4e..efdec89f166 100644 +index f412c985e9..313466717b 100644 --- a/src/lib_protocol_environment/sigs/v15.ml +++ b/src/lib_protocol_environment/sigs/v15.ml -@@ -10049,6 +10049,48 @@ end +@@ -10060,6 +10060,48 @@ end # 106 "v15.in.ml" @@ -97,7 +85,7 @@ index 973d4e40d4e..efdec89f166 100644 module Protocol_hash : sig # 1 "v15/protocol_hash.mli" (*****************************************************************************) -@@ -10079,7 +10121,7 @@ end +@@ -10090,7 +10132,7 @@ end (** Protocol hashes / IDs. *) include S.HASH end @@ -106,7 +94,7 @@ index 973d4e40d4e..efdec89f166 100644 module Context_hash : sig -@@ -10132,7 +10174,7 @@ end +@@ -10143,7 +10185,7 @@ end type version = Version.t end @@ -115,7 +103,7 @@ index 973d4e40d4e..efdec89f166 100644 module Sapling : sig -@@ -10280,7 +10322,7 @@ module Verification : sig +@@ -10291,7 +10333,7 @@ module Verification : sig val final_check : t -> UTXO.transaction -> string -> bool end end @@ -124,7 +112,7 @@ index 973d4e40d4e..efdec89f166 100644 module Timelock : sig -@@ -10337,7 +10379,7 @@ val open_chest : chest -> chest_key -> time:int -> opening_result +@@ -10348,7 +10390,7 @@ val open_chest : chest -> chest_key -> time:int -> opening_result Used for gas accounting*) val get_plaintext_size : chest -> int end @@ -133,7 +121,7 @@ index 973d4e40d4e..efdec89f166 100644 module Vdf : sig -@@ -10425,7 +10467,7 @@ val prove : discriminant -> challenge -> difficulty -> result * proof +@@ -10436,7 +10478,7 @@ val prove : discriminant -> challenge -> difficulty -> result * proof @raise Invalid_argument when inputs are invalid *) val verify : discriminant -> challenge -> difficulty -> result -> proof -> bool end @@ -142,7 +130,7 @@ index 973d4e40d4e..efdec89f166 100644 module Micheline : sig -@@ -10485,7 +10527,7 @@ val annotations : ('l, 'p) node -> string list +@@ -10496,7 +10538,7 @@ val annotations : ('l, 'p) node -> string list val strip_locations : (_, 'p) node -> 'p canonical end @@ -151,7 +139,7 @@ index 973d4e40d4e..efdec89f166 100644 module Block_header : sig -@@ -10542,7 +10584,7 @@ type t = {shell : shell_header; protocol_data : bytes} +@@ -10553,7 +10595,7 @@ type t = {shell : shell_header; protocol_data : bytes} include S.HASHABLE with type t := t and type hash := Block_hash.t end @@ -160,7 +148,7 @@ index 973d4e40d4e..efdec89f166 100644 module Bounded : sig -@@ -10691,7 +10733,7 @@ module Int8 (B : BOUNDS with type ocaml_type := int) : +@@ -10702,7 +10744,7 @@ module Int8 (B : BOUNDS with type ocaml_type := int) : module Uint8 (B : BOUNDS with type ocaml_type := int) : S with type ocaml_type := int end @@ -169,7 +157,7 @@ index 973d4e40d4e..efdec89f166 100644 module Fitness : sig -@@ -10725,7 +10767,7 @@ end +@@ -10736,7 +10778,7 @@ end compared in a lexicographical order (longer list are greater). *) include S.T with type t = bytes list end @@ -178,7 +166,7 @@ index 973d4e40d4e..efdec89f166 100644 module Operation : sig -@@ -10769,7 +10811,7 @@ type t = {shell : shell_header; proto : bytes} +@@ -10780,7 +10822,7 @@ type t = {shell : shell_header; proto : bytes} include S.HASHABLE with type t := t and type hash := Operation_hash.t end @@ -187,7 +175,7 @@ index 973d4e40d4e..efdec89f166 100644 module Context : sig -@@ -11406,7 +11448,7 @@ module Cache : +@@ -11417,7 +11459,7 @@ module Cache : and type key = cache_key and type value = cache_value end @@ -196,7 +184,7 @@ index 973d4e40d4e..efdec89f166 100644 module Updater : sig -@@ -11935,7 +11977,7 @@ end +@@ -11953,7 +11995,7 @@ end not complete until [init] in invoked. *) val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t end @@ -205,7 +193,7 @@ index 973d4e40d4e..efdec89f166 100644 module RPC_context : sig -@@ -12089,7 +12131,7 @@ val make_opt_call3 : +@@ -12107,7 +12149,7 @@ val make_opt_call3 : 'i -> 'o option shell_tzresult Lwt.t end @@ -214,7 +202,7 @@ index 973d4e40d4e..efdec89f166 100644 module Context_binary : sig -@@ -12132,7 +12174,7 @@ module Tree : +@@ -12150,7 +12192,7 @@ module Tree : val make_empty_context : ?root:string -> unit -> t end @@ -223,7 +211,7 @@ index 973d4e40d4e..efdec89f166 100644 module Wasm_2_0_0 : sig -@@ -12206,7 +12248,7 @@ module Make +@@ -12224,7 +12266,7 @@ module Make val get_info : Tree.tree -> info Lwt.t end end @@ -232,7 +220,7 @@ index 973d4e40d4e..efdec89f166 100644 module Plonk : sig -@@ -12325,7 +12367,7 @@ val scalar_array_encoding : scalar array Data_encoding.t +@@ -12343,7 +12385,7 @@ val scalar_array_encoding : scalar array Data_encoding.t on the given [inputs] according to the [public_parameters]. *) val verify : public_parameters -> verifier_inputs -> proof -> bool end @@ -241,7 +229,7 @@ index 973d4e40d4e..efdec89f166 100644 module Dal : sig -@@ -12480,7 +12522,7 @@ val share_is_trap : +@@ -12498,7 +12540,7 @@ val share_is_trap : traps_fraction:Q.t -> (bool, [> `Decoding_error]) Result.t end @@ -250,7 +238,7 @@ index 973d4e40d4e..efdec89f166 100644 module Skip_list : sig -@@ -12712,7 +12754,7 @@ module Make (_ : sig +@@ -12730,7 +12772,7 @@ module Make (_ : sig val basis : int end) : S end @@ -259,17 +247,18 @@ index 973d4e40d4e..efdec89f166 100644 module Smart_rollup : sig -@@ -12769,6 +12811,6 @@ module Inbox_hash : S.HASH +@@ -12787,7 +12829,7 @@ module Inbox_hash : S.HASH (** Smart rollup merkelized payload hashes' hash *) module Merkelized_payload_hashes_hash : S.HASH end -# 144 "v15.in.ml" +# 146 "v15.in.ml" - end + + module Riscv : sig diff --git a/src/lib_protocol_environment/sigs/v15/profiler.mli b/src/lib_protocol_environment/sigs/v15/profiler.mli new file mode 100644 -index 00000000000..3dc7a1c702c +index 0000000000..3dc7a1c702 --- /dev/null +++ b/src/lib_protocol_environment/sigs/v15/profiler.mli @@ -0,0 +1,36 @@ @@ -310,10 +299,10 @@ index 00000000000..3dc7a1c702c + +val mark : verbosity -> ids -> unit diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml -index dea20068c27..d1c37ca6523 100644 +index b8e5d86d62..a77f59c744 100644 --- a/src/proto_alpha/lib_protocol/apply.ml +++ b/src/proto_alpha/lib_protocol/apply.ml -@@ -2377,7 +2377,11 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode +@@ -2504,7 +2504,11 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode ~source ~operation contents_list = let open Lwt_result_syntax in let ctxt = if mempool_mode then Gas.reset_block_gas ctxt else ctxt in @@ -326,7 +315,7 @@ index dea20068c27..d1c37ca6523 100644 let gas_cost_for_sig_check = let algo = Michelson_v1_gas.Cost_of.Interpreter.algo_of_public_key_hash source -@@ -2645,11 +2649,12 @@ let may_start_new_cycle ctxt = +@@ -2780,11 +2784,12 @@ let may_start_new_cycle ctxt = match Level.dawn_of_a_new_cycle ctxt with | None -> return (ctxt, [], []) | Some last_cycle -> @@ -345,10 +334,10 @@ index dea20068c27..d1c37ca6523 100644 let apply_liquidity_baking_subsidy ctxt ~per_block_vote = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/baking.ml b/src/proto_alpha/lib_protocol/baking.ml -index 0af0632f22b..21716f27e31 100644 +index 3bad0551af..0e39978be2 100644 --- a/src/proto_alpha/lib_protocol/baking.ml +++ b/src/proto_alpha/lib_protocol/baking.ml -@@ -84,7 +84,7 @@ type ordered_slots = { +@@ -85,7 +85,7 @@ type ordered_slots = { let attesting_rights (ctxt : t) level = let consensus_committee_size = Constants.consensus_committee_size ctxt in let open Lwt_result_syntax in @@ -357,7 +346,7 @@ index 0af0632f22b..21716f27e31 100644 Slot.Range.rev_fold_es (fun (ctxt, map) slot -> let* ctxt, consensus_pk = Stake_distribution.slot_owner ctxt level slot in -@@ -104,7 +104,7 @@ let attesting_rights (ctxt : t) level = +@@ -106,7 +106,7 @@ let attesting_rights (ctxt : t) level = in return (ctxt, map)) (ctxt, Signature.Public_key_hash.Map.empty) @@ -367,10 +356,10 @@ index 0af0632f22b..21716f27e31 100644 let attesting_rights_by_first_slot ctxt level = let open Lwt_result_syntax in diff --git a/src/proto_alpha/lib_protocol/delegate_cycles.ml b/src/proto_alpha/lib_protocol/delegate_cycles.ml -index db2bd663de9..61812537b09 100644 +index 38b0e96c9c..3de66a1efc 100644 --- a/src/proto_alpha/lib_protocol/delegate_cycles.ml +++ b/src/proto_alpha/lib_protocol/delegate_cycles.ml -@@ -208,42 +208,92 @@ let distribute_attesting_rewards ctxt last_cycle unrevealed_nonces = +@@ -218,42 +218,92 @@ let distribute_attesting_rewards ctxt last_cycle unrevealed_nonces = let cycle_end ctxt last_cycle = let open Lwt_result_syntax in (* attributing attesting rewards *) @@ -478,7 +467,7 @@ index db2bd663de9..61812537b09 100644 let balance_updates = slashing_balance_updates @ attesting_balance_updates in return (ctxt, balance_updates, deactivated_delegates) diff --git a/src/proto_alpha/lib_protocol/dune b/src/proto_alpha/lib_protocol/dune -index 7585aaf197e..fda00885043 100644 +index 1a34312188..4cb8b2b008 100644 --- a/src/proto_alpha/lib_protocol/dune +++ b/src/proto_alpha/lib_protocol/dune @@ -23,6 +23,8 @@ @@ -491,10 +480,10 @@ index 7585aaf197e..fda00885043 100644 (flags (:standard) diff --git a/src/proto_alpha/lib_protocol/init_storage.ml b/src/proto_alpha/lib_protocol/init_storage.ml -index e8f9cc7d713..5b16bd4756b 100644 +index 788d4eec5b..13fbcf3ca2 100644 --- a/src/proto_alpha/lib_protocol/init_storage.ml +++ b/src/proto_alpha/lib_protocol/init_storage.ml -@@ -218,11 +218,19 @@ let prepare_first_block chain_id ctxt ~typecheck_smart_contract +@@ -218,31 +218,55 @@ let prepare_first_block chain_id ctxt ~typecheck_smart_contract (* Start of Alpha stitching. Comment used for automatic snapshot *) | Alpha -> let* ctxt = @@ -514,11 +503,10 @@ index e8f9cc7d713..5b16bd4756b 100644 + {verbosity = Notice} + "Sc_rollup_refutation_storage.migrate_clean_refutation_games"]) in - (* TODO: https://gitlab.com/tezos/tezos/-/issues/7686 - When the predecessor will be R, then delete the code in validate.ml -@@ -233,11 +241,19 @@ let prepare_first_block chain_id ctxt ~typecheck_smart_contract + return (ctxt, []) + (* End of Alpha stitching. Comment used for automatic snapshot *) (* Start of alpha predecessor stitching. Comment used for automatic snapshot *) - | R022 -> + | S023 -> let* ctxt = - Storage.Tenderbake.First_level_of_protocol.update ctxt level + (Storage.Tenderbake.First_level_of_protocol.update @@ -536,9 +524,7 @@ index e8f9cc7d713..5b16bd4756b 100644 + {verbosity = Notice} + "Sc_rollup_refutation_storage.migrate_clean_refutation_games"]) in - (* TODO: https://gitlab.com/tezos/tezos/-/issues/7686 - When the predecessor will be R, then delete the code in validate.ml -@@ -247,10 +263,18 @@ let prepare_first_block chain_id ctxt ~typecheck_smart_contract + return (ctxt, []) (* End of alpha predecessor stitching. Comment used for automatic snapshot *) in let* ctxt = @@ -560,10 +546,10 @@ index e8f9cc7d713..5b16bd4756b 100644 in return ctxt diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml -index e8ebe72b7a3..4bb9f946aef 100644 +index 919dcfc69a..21e4fdb63f 100644 --- a/src/proto_alpha/lib_protocol/raw_context.ml +++ b/src/proto_alpha/lib_protocol/raw_context.ml -@@ -1570,12 +1570,13 @@ let prepare_first_block ~level ~timestamp chain_id ctxt = +@@ -1608,12 +1608,13 @@ let prepare_first_block ~level ~timestamp chain_id ctxt = (* End of alpha predecessor stitching. Comment used for automatic snapshot *) in let+ ctxt = @@ -584,7 +570,7 @@ index e8ebe72b7a3..4bb9f946aef 100644 (previous_proto, previous_proto_constants, ctxt) diff --git a/src/proto_alpha/lib_protocol/script_cache.ml b/src/proto_alpha/lib_protocol/script_cache.ml -index 70a79eb8f44..9724bc4246b 100644 +index 70a79eb8f4..9724bc4246 100644 --- a/src/proto_alpha/lib_protocol/script_cache.ml +++ b/src/proto_alpha/lib_protocol/script_cache.ml @@ -98,15 +98,16 @@ let find ctxt addr = @@ -614,10 +600,10 @@ index 70a79eb8f44..9724bc4246b 100644 let update ctxt identifier updated_script approx_size = Cache.update ctxt identifier (Some (updated_script, approx_size)) diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml -index ff028667e60..6da6a5cce62 100644 +index 90ac344bdd..2a29e2854e 100644 --- a/src/proto_alpha/lib_protocol/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/script_interpreter.ml -@@ -1803,7 +1803,7 @@ type execution_result = { +@@ -1811,7 +1811,7 @@ type execution_result = { let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal unparsed_script cached_script arg = let open Lwt_result_syntax in @@ -626,7 +612,7 @@ index ff028667e60..6da6a5cce62 100644 Script_ir_translator_config.make ~legacy:true ~keep_extra_types_for_interpreter_logging:(Option.is_some logger) -@@ -1856,9 +1856,10 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal +@@ -1864,9 +1864,10 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal Script_ir_translator.collect_lazy_storage ctxt storage_type old_storage in let* (ops, new_storage), ctxt = @@ -640,7 +626,7 @@ index ff028667e60..6da6a5cce62 100644 in let* storage, lazy_storage_diff, ctxt = Script_ir_translator.extract_lazy_storage_diff -@@ -1924,7 +1925,7 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal +@@ -1932,7 +1933,7 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal ticket_diffs; ticket_receipt; }, @@ -650,10 +636,10 @@ index ff028667e60..6da6a5cce62 100644 let execute_with_typed_parameter ?logger ctxt ~cached_script mode step_constants ~script ~entrypoint ~parameter_ty ~location ~parameter ~internal = diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml -index 9041c1f66f8..d395af5f5aa 100644 +index 6f1d8b6bee..43f5715b4a 100644 --- a/src/proto_alpha/lib_protocol/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml -@@ -5223,17 +5223,21 @@ let parse_script : +@@ -5228,17 +5228,21 @@ let parse_script : (Code {code; arg_type; storage_type; views; entrypoints; code_size}), ctxt ) = @@ -684,7 +670,7 @@ index 9041c1f66f8..d395af5f5aa 100644 in ( Ex_script (Script -@@ -5933,15 +5937,15 @@ let list_of_big_map_ids ids = +@@ -5938,15 +5942,15 @@ let list_of_big_map_ids ids = let parse_data ~elab_conf ctxt ~allow_forged_tickets ~allow_forged_lazy_storage_id ty t = @@ -710,5 +696,5 @@ index 9041c1f66f8..d395af5f5aa 100644 let parse_view ~elab_conf ctxt ty view = parse_view ~unparse_code_rec ~elab_conf ctxt ty view -- -2.48.1 +2.50.0 -- GitLab From d8898e56f4dc99648627cd599937c0945e810457 Mon Sep 17 00:00:00 2001 From: mattiasdrp Date: Wed, 2 Jul 2025 12:13:44 +0200 Subject: [PATCH 4/4] Protocols: Add proto_seoul.patch and update patch-profiler-proto.sh accordingly Applying profile_alpha.patch is done with -t : ``` -t or --batch Suppress questions like -f, but make some different assumptions: skip patches whose headers do not contain file names (the same as -f); skip patches for which the file has the wrong version for the Prereq: line in the patch; and assume that patches are reversed if they look like they are. ``` To avoid prompting when creating files that were already created by profile_seoul.patch because both are based on v15 --- scripts/patch-profiler-proto.sh | 5 +- scripts/profile_seoul.patch | 709 ++++++++++++++++++++++++++++++++ 2 files changed, 713 insertions(+), 1 deletion(-) create mode 100644 scripts/profile_seoul.patch diff --git a/scripts/patch-profiler-proto.sh b/scripts/patch-profiler-proto.sh index f01fd1f3c3e9..c62078d3067f 100755 --- a/scripts/patch-profiler-proto.sh +++ b/scripts/patch-profiler-proto.sh @@ -18,4 +18,7 @@ done patch $dry_run -p 1 < scripts/profile_riotuma.patch #shellcheck disable=SC2086 -patch $dry_run -p 1 < scripts/profile_alpha.patch +patch $dry_run -p 1 < scripts/profile_seoul.patch + +#shellcheck disable=SC2086 +patch $dry_run -p 1 -t < scripts/profile_alpha.patch diff --git a/scripts/profile_seoul.patch b/scripts/profile_seoul.patch new file mode 100644 index 000000000000..3590adf3aa03 --- /dev/null +++ b/scripts/profile_seoul.patch @@ -0,0 +1,709 @@ +From 09898a8ad2a62f9ec7e5189c1f4ebca7aa9121e0 Mon Sep 17 00:00:00 2001 +From: mattiasdrp +Date: Wed, 2 Jul 2025 12:09:22 +0200 +Subject: [PATCH] Patch Seoul + +--- + src/lib_protocol_environment/sigs/v15.in.ml | 2 + + src/lib_protocol_environment/sigs/v15.ml | 82 ++++++++++++++----- + .../sigs/v15/profiler.mli | 36 ++++++++ + src/proto_023_PtSeouLo/lib_protocol/apply.ml | 17 ++-- + src/proto_023_PtSeouLo/lib_protocol/baking.ml | 4 +- + .../lib_protocol/delegate_cycles.ml | 78 ++++++++++++++---- + src/proto_023_PtSeouLo/lib_protocol/dune | 2 + + .../lib_protocol/init_storage.ml | 36 ++++++-- + .../lib_protocol/raw_context.ml | 13 +-- + .../lib_protocol/script_cache.ml | 19 +++-- + .../lib_protocol/script_interpreter.ml | 11 +-- + .../lib_protocol/script_ir_translator.ml | 40 +++++---- + 12 files changed, 254 insertions(+), 86 deletions(-) + create mode 100644 src/lib_protocol_environment/sigs/v15/profiler.mli + +diff --git a/src/lib_protocol_environment/sigs/v15.in.ml b/src/lib_protocol_environment/sigs/v15.in.ml +index e86731c9cb..05291026e6 100644 +--- a/src/lib_protocol_environment/sigs/v15.in.ml ++++ b/src/lib_protocol_environment/sigs/v15.in.ml +@@ -105,6 +105,8 @@ module type T = sig + + module Operation_list_list_hash : [%sig "v15/operation_list_list_hash.mli"] + ++ module Profiler : [%sig "v15/profiler.mli"] ++ + module Protocol_hash : [%sig "v15/protocol_hash.mli"] + + module Context_hash : [%sig "v15/context_hash.mli"] +diff --git a/src/lib_protocol_environment/sigs/v15.ml b/src/lib_protocol_environment/sigs/v15.ml +index f412c985e9..437c499bb4 100644 +--- a/src/lib_protocol_environment/sigs/v15.ml ++++ b/src/lib_protocol_environment/sigs/v15.ml +@@ -10060,6 +10060,48 @@ end + # 106 "v15.in.ml" + + ++ module Profiler : sig ++# 1 "v15/profiler.mli" ++(*****************************************************************************) ++(* *) ++(* SPDX-License-Identifier: MIT *) ++(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) ++(* *) ++(*****************************************************************************) ++ ++type metadata = (string * string) list ++ ++type id = string * metadata ++ ++type ids = string list * metadata ++ ++type verbosity = Notice | Info | Debug ++ ++val record : verbosity -> id -> unit ++ ++val record_f : verbosity -> id -> (unit -> 'a) -> 'a ++ ++val record_s : verbosity -> id -> (unit -> 'a Lwt.t) -> 'a Lwt.t ++ ++val aggregate : verbosity -> id -> unit ++ ++val aggregate_f : verbosity -> id -> (unit -> 'a) -> 'a ++ ++val aggregate_s : verbosity -> id -> (unit -> 'a Lwt.t) -> 'a Lwt.t ++ ++val span_f : verbosity -> ids -> (unit -> 'a) -> 'a ++ ++val span_s : verbosity -> ids -> (unit -> 'a Lwt.t) -> 'a Lwt.t ++ ++val stop : unit -> unit ++ ++val stamp : verbosity -> id -> unit ++ ++val mark : verbosity -> ids -> unit ++end ++# 108 "v15.in.ml" ++ ++ + module Protocol_hash : sig + # 1 "v15/protocol_hash.mli" + (*****************************************************************************) +@@ -10090,7 +10132,7 @@ end + (** Protocol hashes / IDs. *) + include S.HASH + end +-# 108 "v15.in.ml" ++# 110 "v15.in.ml" + + + module Context_hash : sig +@@ -10143,7 +10185,7 @@ end + + type version = Version.t + end +-# 110 "v15.in.ml" ++# 112 "v15.in.ml" + + + module Sapling : sig +@@ -10291,7 +10333,7 @@ module Verification : sig + val final_check : t -> UTXO.transaction -> string -> bool + end + end +-# 112 "v15.in.ml" ++# 114 "v15.in.ml" + + + module Timelock : sig +@@ -10348,7 +10390,7 @@ val open_chest : chest -> chest_key -> time:int -> opening_result + Used for gas accounting*) + val get_plaintext_size : chest -> int + end +-# 114 "v15.in.ml" ++# 116 "v15.in.ml" + + + module Vdf : sig +@@ -10436,7 +10478,7 @@ val prove : discriminant -> challenge -> difficulty -> result * proof + @raise Invalid_argument when inputs are invalid *) + val verify : discriminant -> challenge -> difficulty -> result -> proof -> bool + end +-# 116 "v15.in.ml" ++# 118 "v15.in.ml" + + + module Micheline : sig +@@ -10496,7 +10538,7 @@ val annotations : ('l, 'p) node -> string list + + val strip_locations : (_, 'p) node -> 'p canonical + end +-# 118 "v15.in.ml" ++# 120 "v15.in.ml" + + + module Block_header : sig +@@ -10553,7 +10595,7 @@ type t = {shell : shell_header; protocol_data : bytes} + + include S.HASHABLE with type t := t and type hash := Block_hash.t + end +-# 120 "v15.in.ml" ++# 122 "v15.in.ml" + + + module Bounded : sig +@@ -10702,7 +10744,7 @@ module Int8 (B : BOUNDS with type ocaml_type := int) : + module Uint8 (B : BOUNDS with type ocaml_type := int) : + S with type ocaml_type := int + end +-# 122 "v15.in.ml" ++# 124 "v15.in.ml" + + + module Fitness : sig +@@ -10736,7 +10778,7 @@ end + compared in a lexicographical order (longer list are greater). *) + include S.T with type t = bytes list + end +-# 124 "v15.in.ml" ++# 126 "v15.in.ml" + + + module Operation : sig +@@ -10780,7 +10822,7 @@ type t = {shell : shell_header; proto : bytes} + + include S.HASHABLE with type t := t and type hash := Operation_hash.t + end +-# 126 "v15.in.ml" ++# 128 "v15.in.ml" + + + module Context : sig +@@ -11417,7 +11459,7 @@ module Cache : + and type key = cache_key + and type value = cache_value + end +-# 128 "v15.in.ml" ++# 130 "v15.in.ml" + + + module Updater : sig +@@ -11953,7 +11995,7 @@ end + not complete until [init] in invoked. *) + val activate : Context.t -> Protocol_hash.t -> Context.t Lwt.t + end +-# 130 "v15.in.ml" ++# 132 "v15.in.ml" + + + module RPC_context : sig +@@ -12107,7 +12149,7 @@ val make_opt_call3 : + 'i -> + 'o option shell_tzresult Lwt.t + end +-# 132 "v15.in.ml" ++# 134 "v15.in.ml" + + + module Context_binary : sig +@@ -12150,7 +12192,7 @@ module Tree : + + val make_empty_context : ?root:string -> unit -> t + end +-# 134 "v15.in.ml" ++# 136 "v15.in.ml" + + + module Wasm_2_0_0 : sig +@@ -12224,7 +12266,7 @@ module Make + val get_info : Tree.tree -> info Lwt.t + end + end +-# 136 "v15.in.ml" ++# 138 "v15.in.ml" + + + module Plonk : sig +@@ -12343,7 +12385,7 @@ val scalar_array_encoding : scalar array Data_encoding.t + on the given [inputs] according to the [public_parameters]. *) + val verify : public_parameters -> verifier_inputs -> proof -> bool + end +-# 138 "v15.in.ml" ++# 140 "v15.in.ml" + + + module Dal : sig +@@ -12498,7 +12540,7 @@ val share_is_trap : + traps_fraction:Q.t -> + (bool, [> `Decoding_error]) Result.t + end +-# 140 "v15.in.ml" ++# 142 "v15.in.ml" + + + module Skip_list : sig +@@ -12730,7 +12772,7 @@ module Make (_ : sig + val basis : int + end) : S + end +-# 142 "v15.in.ml" ++# 144 "v15.in.ml" + + + module Smart_rollup : sig +@@ -12787,7 +12829,7 @@ module Inbox_hash : S.HASH + (** Smart rollup merkelized payload hashes' hash *) + module Merkelized_payload_hashes_hash : S.HASH + end +-# 144 "v15.in.ml" ++# 146 "v15.in.ml" + + + module Riscv : sig +@@ -12850,6 +12892,6 @@ val bytes_to_output_proof : bytes -> (output_proof, string) result + + val get_current_level : state -> int32 option Lwt.t + end +-# 146 "v15.in.ml" ++# 148 "v15.in.ml" + + end +diff --git a/src/lib_protocol_environment/sigs/v15/profiler.mli b/src/lib_protocol_environment/sigs/v15/profiler.mli +new file mode 100644 +index 0000000000..3dc7a1c702 +--- /dev/null ++++ b/src/lib_protocol_environment/sigs/v15/profiler.mli +@@ -0,0 +1,36 @@ ++(*****************************************************************************) ++(* *) ++(* SPDX-License-Identifier: MIT *) ++(* SPDX-FileCopyrightText: 2024 Nomadic Labs *) ++(* *) ++(*****************************************************************************) ++ ++type metadata = (string * string) list ++ ++type id = string * metadata ++ ++type ids = string list * metadata ++ ++type verbosity = Notice | Info | Debug ++ ++val record : verbosity -> id -> unit ++ ++val record_f : verbosity -> id -> (unit -> 'a) -> 'a ++ ++val record_s : verbosity -> id -> (unit -> 'a Lwt.t) -> 'a Lwt.t ++ ++val aggregate : verbosity -> id -> unit ++ ++val aggregate_f : verbosity -> id -> (unit -> 'a) -> 'a ++ ++val aggregate_s : verbosity -> id -> (unit -> 'a Lwt.t) -> 'a Lwt.t ++ ++val span_f : verbosity -> ids -> (unit -> 'a) -> 'a ++ ++val span_s : verbosity -> ids -> (unit -> 'a Lwt.t) -> 'a Lwt.t ++ ++val stop : unit -> unit ++ ++val stamp : verbosity -> id -> unit ++ ++val mark : verbosity -> ids -> unit +diff --git a/src/proto_023_PtSeouLo/lib_protocol/apply.ml b/src/proto_023_PtSeouLo/lib_protocol/apply.ml +index b8e5d86d62..a77f59c744 100644 +--- a/src/proto_023_PtSeouLo/lib_protocol/apply.ml ++++ b/src/proto_023_PtSeouLo/lib_protocol/apply.ml +@@ -2504,7 +2504,11 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode + ~source ~operation contents_list = + let open Lwt_result_syntax in + let ctxt = if mempool_mode then Gas.reset_block_gas ctxt else ctxt in +- let* ctxt, fees_updated_contents_list = take_fees ctxt contents_list in ++ let* ctxt, fees_updated_contents_list = ++ (take_fees ++ ctxt ++ contents_list [@profiler.record_s {verbosity = Notice} "take_fees"]) ++ in + let gas_cost_for_sig_check = + let algo = + Michelson_v1_gas.Cost_of.Interpreter.algo_of_public_key_hash source +@@ -2780,11 +2784,12 @@ let may_start_new_cycle ctxt = + match Level.dawn_of_a_new_cycle ctxt with + | None -> return (ctxt, [], []) + | Some last_cycle -> +- let* ctxt, balance_updates, deactivated = +- Delegate.cycle_end ctxt last_cycle +- in +- let+ ctxt = Bootstrap.cycle_end ctxt last_cycle in +- (ctxt, balance_updates, deactivated) ++ (let* ctxt, balance_updates, deactivated = ++ Delegate.cycle_end ctxt last_cycle ++ in ++ let+ ctxt = Bootstrap.cycle_end ctxt last_cycle in ++ (ctxt, balance_updates, deactivated)) ++ [@profiler.record_s {verbosity = Notice} "delegate end cycle"] + + let apply_liquidity_baking_subsidy ctxt ~per_block_vote = + let open Lwt_result_syntax in +diff --git a/src/proto_023_PtSeouLo/lib_protocol/baking.ml b/src/proto_023_PtSeouLo/lib_protocol/baking.ml +index 3bad0551af..0e39978be2 100644 +--- a/src/proto_023_PtSeouLo/lib_protocol/baking.ml ++++ b/src/proto_023_PtSeouLo/lib_protocol/baking.ml +@@ -85,7 +85,7 @@ type ordered_slots = { + let attesting_rights (ctxt : t) level = + let consensus_committee_size = Constants.consensus_committee_size ctxt in + let open Lwt_result_syntax in +- let*? slots = Slot.Range.create ~min:0 ~count:consensus_committee_size in ++ (let*? slots = Slot.Range.create ~min:0 ~count:consensus_committee_size in + Slot.Range.rev_fold_es + (fun (ctxt, map) slot -> + let* ctxt, consensus_pk = Stake_distribution.slot_owner ctxt level slot in +@@ -106,7 +106,7 @@ let attesting_rights (ctxt : t) level = + in + return (ctxt, map)) + (ctxt, Signature.Public_key_hash.Map.empty) +- slots ++ slots) [@profiler.record_s {verbosity = Notice} "attesting_rights_by_first_slot"] + + let attesting_rights_by_first_slot ctxt level = + let open Lwt_result_syntax in +diff --git a/src/proto_023_PtSeouLo/lib_protocol/delegate_cycles.ml b/src/proto_023_PtSeouLo/lib_protocol/delegate_cycles.ml +index 38b0e96c9c..3de66a1efc 100644 +--- a/src/proto_023_PtSeouLo/lib_protocol/delegate_cycles.ml ++++ b/src/proto_023_PtSeouLo/lib_protocol/delegate_cycles.ml +@@ -218,42 +218,92 @@ let distribute_attesting_rewards ctxt last_cycle unrevealed_nonces = + let cycle_end ctxt last_cycle = + let open Lwt_result_syntax in + (* attributing attesting rewards *) +- let* ctxt, unrevealed_nonces = Seed_storage.cycle_end ctxt last_cycle in ++ let* ctxt, unrevealed_nonces = ++ (Seed_storage.cycle_end ++ ctxt ++ last_cycle ++ [@profiler.record_s {verbosity = Notice} "seed storage cycle end"]) ++ in + let* ctxt, attesting_balance_updates = +- distribute_attesting_rewards ctxt last_cycle unrevealed_nonces ++ (distribute_attesting_rewards ++ ctxt ++ last_cycle ++ unrevealed_nonces ++ [@profiler.record_s {verbosity = Notice} "distribute attesting rewards"]) + in + (* Applying slashing related to expiring denunciations *) + let* ctxt, slashing_balance_updates = +- Delegate_slashed_deposits_storage.apply_and_clear_denunciations ctxt ++ (Delegate_slashed_deposits_storage.apply_and_clear_denunciations ++ ctxt ++ [@profiler.record_s {verbosity = Notice} "apply and clear denunciations"]) + in + let new_cycle = Cycle_repr.add last_cycle 1 in +- let*! ctxt = Already_denounced_storage.clear_outdated_cycle ctxt ~new_cycle in ++ let*! ctxt = ++ (Already_denounced_storage.clear_outdated_cycle ++ ctxt ++ ~new_cycle ++ [@profiler.record_s {verbosity = Notice} "clear outdated cycle"]) ++ in + let*! ctxt = + Dal_already_denounced_storage.clear_outdated_cycle ctxt ~new_cycle + in + (* Deactivating delegates which didn't participate to consensus for too long *) +- let* ctxt, deactivated_delegates = update_activity ctxt last_cycle in ++ let* ctxt, deactivated_delegates = ++ (update_activity ++ ctxt ++ last_cycle [@profiler.record_s {verbosity = Notice} "update activity"]) ++ in + (* Computing future staking rights *) + let* ctxt = +- Delegate_sampler.select_new_distribution_at_cycle_end ctxt ~new_cycle ++ (Delegate_sampler.select_new_distribution_at_cycle_end ++ ctxt ++ ~new_cycle ++ [@profiler.record_s ++ {verbosity = Notice} "select new distribution at cycle end"]) + in + (* Activating consensus key for the cycle to come *) +- let*! ctxt = Delegate_consensus_key.activate ctxt ~new_cycle in ++ let*! ctxt = ++ (Delegate_consensus_key.activate ++ ctxt ++ ~new_cycle ++ [@profiler.record_s {verbosity = Notice} "activate consensus key"]) ++ in + (* trying to unforbid delegates for the cycle to come. *) + let* ctxt = +- Forbidden_delegates_storage.update_at_cycle_end_after_slashing +- ctxt +- ~new_cycle ++ (Forbidden_delegates_storage.update_at_cycle_end_after_slashing ++ ctxt ++ ~new_cycle ++ [@profiler.record_s ++ {verbosity = Notice} "update at cycle end after slashing"]) + in + (* clear deprecated cycles data. *) +- let* ctxt = Stake_storage.clear_at_cycle_end ctxt ~new_cycle in +- let* ctxt = Delegate_sampler.clear_outdated_sampling_data ctxt ~new_cycle in ++ let* ctxt = ++ (Stake_storage.clear_at_cycle_end ++ ctxt ++ ~new_cycle ++ [@profiler.record_s {verbosity = Notice} "clear stake storage"]) ++ in ++ let* ctxt = ++ (Delegate_sampler.clear_outdated_sampling_data ++ ctxt ++ ~new_cycle ++ [@profiler.record_s {verbosity = Notice} "clear outdated sampling data"]) ++ in + (* activate delegate parameters for the cycle to come. *) +- let*! ctxt = Delegate_staking_parameters.activate ctxt ~new_cycle in ++ let*! ctxt = ++ (Delegate_staking_parameters.activate ++ ctxt ++ ~new_cycle ++ [@profiler.record_s {verbosity = Notice} "activate staking parameters"]) ++ in + (* updating AI coefficient. It should remain after all balance changes of the + cycle-end operations *) + let* ctxt = +- Adaptive_issuance_storage.update_stored_rewards_at_cycle_end ctxt ~new_cycle ++ (Adaptive_issuance_storage.update_stored_rewards_at_cycle_end ++ ctxt ++ ~new_cycle ++ [@profiler.record_s ++ {verbosity = Notice} "update stored rewards at cycle end"]) + in + let balance_updates = slashing_balance_updates @ attesting_balance_updates in + return (ctxt, balance_updates, deactivated_delegates) +diff --git a/src/proto_023_PtSeouLo/lib_protocol/dune b/src/proto_023_PtSeouLo/lib_protocol/dune +index edf7596fe2..a4d415a35e 100644 +--- a/src/proto_023_PtSeouLo/lib_protocol/dune ++++ b/src/proto_023_PtSeouLo/lib_protocol/dune +@@ -23,6 +23,8 @@ + (instrumentation (backend bisect_ppx)) + (libraries + tezos-protocol-023-PtSeouLo.protocol.environment) ++ (preprocess (pps octez-libs.ppx_profiler)) ++ (preprocessor_deps (env_var TEZOS_PPX_PROFILER)) + (library_flags (:standard -linkall)) + (flags + (:standard) +diff --git a/src/proto_023_PtSeouLo/lib_protocol/init_storage.ml b/src/proto_023_PtSeouLo/lib_protocol/init_storage.ml +index 2f67de0f87..814348bbc6 100644 +--- a/src/proto_023_PtSeouLo/lib_protocol/init_storage.ml ++++ b/src/proto_023_PtSeouLo/lib_protocol/init_storage.ml +@@ -240,32 +240,56 @@ let prepare_first_block chain_id ctxt ~typecheck_smart_contract + (* Start of S023 stitching. Comment used for automatic snapshot *) + | S023 -> + let* ctxt = +- Storage.Tenderbake.First_level_of_protocol.update ctxt level ++ (Storage.Tenderbake.First_level_of_protocol.update ++ ctxt ++ level ++ [@profiler.record_s ++ {verbosity = Notice} "Tenderbake.First_level_of_protocol.update"]) + in + (* Migration of refutation games needs to be kept for each protocol. *) + let* ctxt = +- Sc_rollup_refutation_storage.migrate_clean_refutation_games ctxt ++ (Sc_rollup_refutation_storage.migrate_clean_refutation_games ++ ctxt ++ [@profiler.record_s ++ {verbosity = Notice} ++ "Sc_rollup_refutation_storage.migrate_clean_refutation_games"]) + in + return (ctxt, []) + (* End of S023 stitching. Comment used for automatic snapshot *) + (* Start of alpha predecessor stitching. Comment used for automatic snapshot *) + | R022 -> + let* ctxt = +- Storage.Tenderbake.First_level_of_protocol.update ctxt level ++ (Storage.Tenderbake.First_level_of_protocol.update ++ ctxt ++ level ++ [@profiler.record_s ++ {verbosity = Notice} "Tenderbake.First_level_of_protocol.update"]) + in + (* Migration of refutation games needs to be kept for each protocol. *) + let* ctxt = +- Sc_rollup_refutation_storage.migrate_clean_refutation_games ctxt ++ (Sc_rollup_refutation_storage.migrate_clean_refutation_games ++ ctxt ++ [@profiler.record_s ++ {verbosity = Notice} ++ "Sc_rollup_refutation_storage.migrate_clean_refutation_games"]) + in + let* ctxt = update_delegate_sampler_state_value_type_from_R_to_S ctxt in + return (ctxt, []) + (* End of alpha predecessor stitching. Comment used for automatic snapshot *) + in + let* ctxt = +- List.fold_left_es patch_script ctxt Legacy_script_patches.addresses_to_patch ++ (List.fold_left_es ++ patch_script ++ ctxt ++ Legacy_script_patches.addresses_to_patch ++ [@profiler.record_s {verbosity = Notice} "patch_script"]) + in + let*? balance_updates = Receipt_repr.group_balance_updates balance_updates in + let*! ctxt = +- Storage.Pending_migration.Balance_updates.add ctxt balance_updates ++ (Storage.Pending_migration.Balance_updates.add ++ ctxt ++ balance_updates ++ [@profiler.record_s ++ {verbosity = Notice} "Storage.Pending_migration.Balance_updates.add"]) + in + return ctxt +diff --git a/src/proto_023_PtSeouLo/lib_protocol/raw_context.ml b/src/proto_023_PtSeouLo/lib_protocol/raw_context.ml +index 024d92cb2b..7eb6ddc076 100644 +--- a/src/proto_023_PtSeouLo/lib_protocol/raw_context.ml ++++ b/src/proto_023_PtSeouLo/lib_protocol/raw_context.ml +@@ -1647,12 +1647,13 @@ let prepare_first_block ~level ~timestamp chain_id ctxt = + (* End of alpha predecessor stitching. Comment used for automatic snapshot *) + in + let+ ctxt = +- prepare +- ctxt +- ~level +- ~predecessor_timestamp:timestamp +- ~timestamp +- ~adaptive_issuance_enable:false ++ (prepare ++ ctxt ++ ~level ++ ~predecessor_timestamp:timestamp ++ ~timestamp ++ ~adaptive_issuance_enable:false ++ [@profiler.record_s {verbosity = Notice} "Prepare"]) + in + (previous_proto, previous_proto_constants, ctxt) + +diff --git a/src/proto_023_PtSeouLo/lib_protocol/script_cache.ml b/src/proto_023_PtSeouLo/lib_protocol/script_cache.ml +index 70a79eb8f4..9724bc4246 100644 +--- a/src/proto_023_PtSeouLo/lib_protocol/script_cache.ml ++++ b/src/proto_023_PtSeouLo/lib_protocol/script_cache.ml +@@ -98,15 +98,16 @@ let find ctxt addr = + | Some (unparsed_script, ex_script) -> + return (ctxt, identifier, Some (unparsed_script, ex_script)) + | None -> ( +- let* ctxt, result = load_and_elaborate ctxt addr in +- match result with +- | None -> return (ctxt, identifier, None) +- | Some (unparsed_script, script_ir, size) -> +- let cached_value = (unparsed_script, script_ir) in +- let*? ctxt = +- Cache.update ctxt identifier (Some (cached_value, size)) +- in +- return (ctxt, identifier, Some (unparsed_script, script_ir))) ++ (let* ctxt, result = load_and_elaborate ctxt addr in ++ match result with ++ | None -> return (ctxt, identifier, None) ++ | Some (unparsed_script, script_ir, size) -> ++ let cached_value = (unparsed_script, script_ir) in ++ let*? ctxt = ++ Cache.update ctxt identifier (Some (cached_value, size)) ++ in ++ return (ctxt, identifier, Some (unparsed_script, script_ir))) ++ [@profiler.record_s {verbosity = Notice} "cache_miss"]) + + let update ctxt identifier updated_script approx_size = + Cache.update ctxt identifier (Some (updated_script, approx_size)) +diff --git a/src/proto_023_PtSeouLo/lib_protocol/script_interpreter.ml b/src/proto_023_PtSeouLo/lib_protocol/script_interpreter.ml +index 90ac344bdd..2a29e2854e 100644 +--- a/src/proto_023_PtSeouLo/lib_protocol/script_interpreter.ml ++++ b/src/proto_023_PtSeouLo/lib_protocol/script_interpreter.ml +@@ -1811,7 +1811,7 @@ type execution_result = { + let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal + unparsed_script cached_script arg = + let open Lwt_result_syntax in +- let elab_conf = ++ (let elab_conf = + Script_ir_translator_config.make + ~legacy:true + ~keep_extra_types_for_interpreter_logging:(Option.is_some logger) +@@ -1864,9 +1864,10 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal + Script_ir_translator.collect_lazy_storage ctxt storage_type old_storage + in + let* (ops, new_storage), ctxt = +- trace +- (Runtime_contract_error step_constants.self) +- (interp logger (ctxt, step_constants) code (arg, old_storage)) ++ (trace ++ (Runtime_contract_error step_constants.self) ++ (interp logger (ctxt, step_constants) code (arg, old_storage)) ++ [@profiler.record_s {verbosity = Notice} "interprete"]) + in + let* storage, lazy_storage_diff, ctxt = + Script_ir_translator.extract_lazy_storage_diff +@@ -1932,7 +1933,7 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal + ticket_diffs; + ticket_receipt; + }, +- ctxt ) ++ ctxt )) [@profiler.record_s {verbosity = Notice} "execute"] + + let execute_with_typed_parameter ?logger ctxt ~cached_script mode step_constants + ~script ~entrypoint ~parameter_ty ~location ~parameter ~internal = +diff --git a/src/proto_023_PtSeouLo/lib_protocol/script_ir_translator.ml b/src/proto_023_PtSeouLo/lib_protocol/script_ir_translator.ml +index 6f1d8b6bee..43f5715b4a 100644 +--- a/src/proto_023_PtSeouLo/lib_protocol/script_ir_translator.ml ++++ b/src/proto_023_PtSeouLo/lib_protocol/script_ir_translator.ml +@@ -5228,17 +5228,21 @@ let parse_script : + (Code + {code; arg_type; storage_type; views; entrypoints; code_size}), + ctxt ) = +- parse_code ~unparse_code_rec ~elab_conf ctxt ~code ++ (parse_code ++ ~unparse_code_rec ++ ~elab_conf ++ ctxt ++ ~code [@profiler.record_s {verbosity = Notice} "parse_code"]) + in + let+ storage, ctxt = +- parse_storage +- ~unparse_code_rec +- ~elab_conf +- ctxt +- ~allow_forged_tickets:allow_forged_tickets_in_storage +- ~allow_forged_lazy_storage_id:allow_forged_lazy_storage_id_in_storage +- storage_type +- ~storage ++ (parse_storage ++ ~unparse_code_rec ++ ~elab_conf ++ ctxt ++ ~allow_forged_tickets:allow_forged_tickets_in_storage ++ ~allow_forged_lazy_storage_id:allow_forged_lazy_storage_id_in_storage ++ storage_type ++ ~storage [@profiler.record_s {verbosity = Notice} "parse_storage"]) + in + ( Ex_script + (Script +@@ -5938,15 +5942,15 @@ let list_of_big_map_ids ids = + + let parse_data ~elab_conf ctxt ~allow_forged_tickets + ~allow_forged_lazy_storage_id ty t = +- parse_data +- ~unparse_code_rec +- ~elab_conf +- ~allow_forged_tickets +- ~allow_forged_lazy_storage_id +- ~stack_depth:0 +- ctxt +- ty +- t ++ (parse_data ++ ~unparse_code_rec ++ ~elab_conf ++ ~allow_forged_tickets ++ ~allow_forged_lazy_storage_id ++ ~stack_depth:0 ++ ctxt ++ ty ++ t [@profiler.record_s {verbosity = Notice} "parse_data"]) + + let parse_view ~elab_conf ctxt ty view = + parse_view ~unparse_code_rec ~elab_conf ctxt ty view +-- +2.50.0 + -- GitLab