From df4eafe849c201a007537156977802ac392dc464 Mon Sep 17 00:00:00 2001 From: Sventimir Date: Thu, 16 Jun 2022 16:35:02 +0200 Subject: [PATCH 1/6] Get_contracts: add measurement of contracts' mem consumption. For each contract output an additional file *.size, in which memory footprint of the smart contract is stored, counted in memory words the the contract occupies in cache. --- devtools/get_contracts/get_contracts.ml | 54 +++++++++++-------- .../get_contracts_012_Psithaca.ml | 10 +++- .../get_contracts_013_PtJakart.ml | 10 +++- devtools/get_contracts/get_contracts_alpha.ml | 10 +++- devtools/get_contracts/sigs.ml | 7 ++- 5 files changed, 66 insertions(+), 25 deletions(-) diff --git a/devtools/get_contracts/get_contracts.ml b/devtools/get_contracts/get_contracts.ml index 7f78ff043186..b3855f5582ce 100644 --- a/devtools/get_contracts/get_contracts.ml +++ b/devtools/get_contracts/get_contracts.ml @@ -449,27 +449,39 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct else return (contract_map, (ExprMap.empty, ExprMap.empty, ExprMap.empty)) in print_endline "Writing contract files..." ; - ExprMap.iter - (fun hash (script, contracts, storages) -> - let hash_string = P.Script.Hash.to_b58check hash in - File_helpers.print_expr_file - ~dirname:output_dir - ~ext:".tz" - ~hash_string - script ; - let filename = - Filename.concat output_dir (hash_string ^ ".addresses") - in - File_helpers.print_to_file - filename - "%a" - (Format.pp_print_list ~pp_sep:Format.pp_print_newline P.Contract.pp) - contracts ; - if Config.collect_storage then - let dirname = Filename.concat output_dir (hash_string ^ ".storage") in - File_helpers.print_expr_dir ~dirname ~ext:".storage" storages - else ()) - contract_map ; + let* () = + ExprMap.iter_es + (fun hash (script, contracts, storages) -> + let hash_string = P.Script.Hash.to_b58check hash in + let* script_code = + P.Translator.parse_code ctxt ~legacy:true + @@ P.Script.lazy_expr script + in + let size = Obj.(reachable_words @@ repr script_code) in + File_helpers.print_expr_file + ~dirname:output_dir + ~ext:".tz" + ~hash_string + script ; + let filename ~ext = + Filename.concat output_dir (Format.sprintf "%s.%s" hash_string ext) + in + File_helpers.print_to_file + (filename ~ext:"address") + "%a" + (Format.pp_print_list ~pp_sep:Format.pp_print_newline P.Contract.pp) + contracts ; + File_helpers.print_to_file (filename ~ext:"size") "%d words" size ; + return + @@ + if Config.collect_storage then + let dirname = + Filename.concat output_dir (hash_string ^ ".storage") + in + File_helpers.print_expr_dir ~dirname ~ext:".storage" storages + else ()) + contract_map + in print_endline "Done writing contract files." ; let () = if not (ExprMap.is_empty lambda_map) then ( diff --git a/devtools/get_contracts/get_contracts_012_Psithaca.ml b/devtools/get_contracts/get_contracts_012_Psithaca.ml index 4155af2943f0..6649f0370c35 100644 --- a/devtools/get_contracts/get_contracts_012_Psithaca.ml +++ b/devtools/get_contracts/get_contracts_012_Psithaca.ml @@ -65,7 +65,7 @@ module Proto = struct type ex_ty = Script_ir_translator.ex_ty - type type_logger = Script_ir_translator.type_logger + type ex_code = Script_ir_translator.ex_code let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = @@ -113,6 +113,14 @@ module Proto = struct @@ Script_ir_translator.parse_toplevel (Obj.magic ctxt) ~legacy expr in toplevel + + let parse_code ctxt ~legacy code = + let open Lwt_result_syntax in + let+ parsed_code, _ = + Lwt.map wrap_tzresult + @@ Script_ir_translator.parse_code (Obj.magic ctxt) ~legacy ~code + in + parsed_code end module Storage = struct diff --git a/devtools/get_contracts/get_contracts_013_PtJakart.ml b/devtools/get_contracts/get_contracts_013_PtJakart.ml index ef61c920eea0..fc296b3b114a 100644 --- a/devtools/get_contracts/get_contracts_013_PtJakart.ml +++ b/devtools/get_contracts/get_contracts_013_PtJakart.ml @@ -65,7 +65,7 @@ module Proto = struct type ex_ty = Script_ir_translator.ex_ty - type type_logger = Script_ir_translator.type_logger + type ex_code = Script_ir_translator.ex_code let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = @@ -113,6 +113,14 @@ module Proto = struct @@ Script_ir_translator.parse_toplevel (Obj.magic ctxt) ~legacy expr in toplevel + + let parse_code ctxt ~legacy code = + let open Lwt_result_syntax in + let+ parsed_code, _ = + Lwt.map wrap_tzresult + @@ Script_ir_translator.parse_code (Obj.magic ctxt) ~legacy ~code + in + parsed_code end module Storage = struct diff --git a/devtools/get_contracts/get_contracts_alpha.ml b/devtools/get_contracts/get_contracts_alpha.ml index 92447dd9fdc6..08fc001f7dc2 100644 --- a/devtools/get_contracts/get_contracts_alpha.ml +++ b/devtools/get_contracts/get_contracts_alpha.ml @@ -67,7 +67,7 @@ module Proto = struct type ex_ty = Script_ir_translator.ex_ty - type type_logger = Script_ir_translator.type_logger + type ex_code = Script_ir_translator.ex_code let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = @@ -115,6 +115,14 @@ module Proto = struct @@ Script_ir_translator.parse_toplevel (Obj.magic ctxt) ~legacy expr in toplevel + + let parse_code ctxt ~legacy code = + let open Lwt_result_syntax in + let+ parsed_code, _ = + Lwt.map wrap_tzresult + @@ Script_ir_translator.parse_code (Obj.magic ctxt) ~legacy ~code + in + parsed_code end module Storage = struct diff --git a/devtools/get_contracts/sigs.ml b/devtools/get_contracts/sigs.ml index 5d2640a51128..531e793d3ed0 100644 --- a/devtools/get_contracts/sigs.ml +++ b/devtools/get_contracts/sigs.ml @@ -58,6 +58,8 @@ module type PROTOCOL = sig val expr_encoding : expr Data_encoding.t + val lazy_expr : expr -> lazy_expr + val print_expr : Format.formatter -> expr -> unit module Hash : sig @@ -92,7 +94,7 @@ module type PROTOCOL = sig type ex_ty - type type_logger + type ex_code val parse_ty : context -> @@ -108,6 +110,9 @@ module type PROTOCOL = sig val parse_toplevel : context -> legacy:bool -> Script.expr -> toplevel tzresult Lwt.t + + val parse_code : + context -> legacy:bool -> Script.lazy_expr -> ex_code tzresult Lwt.t end module Storage : sig -- GitLab From 36da3dbfb6022b7e33d853a9988685c94418d323 Mon Sep 17 00:00:00 2001 From: Sventimir Date: Fri, 17 Jun 2022 08:41:14 +0200 Subject: [PATCH 2/6] Get_contracts: Extract contract results output as separate function. --- devtools/get_contracts/get_contracts.ml | 61 +++++++++---------- .../get_contracts_014_PtKathma.ml | 17 +++++- 2 files changed, 46 insertions(+), 32 deletions(-) diff --git a/devtools/get_contracts/get_contracts.ml b/devtools/get_contracts/get_contracts.ml index b3855f5582ce..e0e9d3eac529 100644 --- a/devtools/get_contracts/get_contracts.ml +++ b/devtools/get_contracts/get_contracts.ml @@ -353,6 +353,35 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct let* _ctxt, values = P.Storage.list_values ctxt_i in List.fold_left_es (fun acc v -> f v acc) init values + let output_contract_results ctxt output_dir hash (script, contracts, storages) + = + let open Lwt_result_syntax in + let hash_string = P.Script.Hash.to_b58check hash in + let* script_code = + P.Translator.parse_code ctxt ~legacy:true @@ P.Script.lazy_expr script + in + let size = Obj.(reachable_words @@ repr script_code) in + File_helpers.print_expr_file + ~dirname:output_dir + ~ext:".tz" + ~hash_string + script ; + let filename ~ext = + Filename.concat output_dir (Format.sprintf "%s.%s" hash_string ext) + in + File_helpers.print_to_file + (filename ~ext:"address") + "%a" + (Format.pp_print_list ~pp_sep:Format.pp_print_newline P.Contract.pp) + contracts ; + File_helpers.print_to_file (filename ~ext:"size") "%d words" size ; + return + @@ + if Config.collect_storage then + let dirname = Filename.concat output_dir (hash_string ^ ".storage") in + File_helpers.print_expr_dir ~dirname ~ext:".storage" storages + else () + let main ~output_dir ctxt ~head : unit tzresult Lwt.t = let open Lwt_result_syntax in let head_hash, head_level = Tezos_store.Store.Block.descriptor head in @@ -450,37 +479,7 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct in print_endline "Writing contract files..." ; let* () = - ExprMap.iter_es - (fun hash (script, contracts, storages) -> - let hash_string = P.Script.Hash.to_b58check hash in - let* script_code = - P.Translator.parse_code ctxt ~legacy:true - @@ P.Script.lazy_expr script - in - let size = Obj.(reachable_words @@ repr script_code) in - File_helpers.print_expr_file - ~dirname:output_dir - ~ext:".tz" - ~hash_string - script ; - let filename ~ext = - Filename.concat output_dir (Format.sprintf "%s.%s" hash_string ext) - in - File_helpers.print_to_file - (filename ~ext:"address") - "%a" - (Format.pp_print_list ~pp_sep:Format.pp_print_newline P.Contract.pp) - contracts ; - File_helpers.print_to_file (filename ~ext:"size") "%d words" size ; - return - @@ - if Config.collect_storage then - let dirname = - Filename.concat output_dir (hash_string ^ ".storage") - in - File_helpers.print_expr_dir ~dirname ~ext:".storage" storages - else ()) - contract_map + ExprMap.iter_es (output_contract_results ctxt output_dir) contract_map in print_endline "Done writing contract files." ; let () = diff --git a/devtools/get_contracts/get_contracts_014_PtKathma.ml b/devtools/get_contracts/get_contracts_014_PtKathma.ml index 92447dd9fdc6..75ba10925c0a 100644 --- a/devtools/get_contracts/get_contracts_014_PtKathma.ml +++ b/devtools/get_contracts/get_contracts_014_PtKathma.ml @@ -67,7 +67,14 @@ module Proto = struct type ex_ty = Script_ir_translator.ex_ty - type type_logger = Script_ir_translator.type_logger + type ex_code = Script_ir_translator.ex_code + + let expected_code_size Script_ir_translator.(Ex_code (Code {code_size; _})) + = + Obj.magic code_size + + let actual_code_size Script_ir_translator.(Ex_code (Code {code; _})) = + 8 * Obj.(reachable_words @@ repr code) let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = @@ -115,6 +122,14 @@ module Proto = struct @@ Script_ir_translator.parse_toplevel (Obj.magic ctxt) ~legacy expr in toplevel + + let parse_code ctxt ~legacy code = + let open Lwt_result_syntax in + let+ parsed_code, _ = + Lwt.map wrap_tzresult + @@ Script_ir_translator.parse_code (Obj.magic ctxt) ~legacy ~code + in + parsed_code end module Storage = struct -- GitLab From d53ffda45d55dcc6077c9996e957a1a82f079c74 Mon Sep 17 00:00:00 2001 From: Sventimir Date: Fri, 17 Jun 2022 09:16:29 +0200 Subject: [PATCH 3/6] Get_contracts: Also output size of contracts expected by our model. --- devtools/get_contracts/get_contracts.ml | 9 +++++++-- devtools/get_contracts/get_contracts_012_Psithaca.ml | 3 +++ devtools/get_contracts/get_contracts_013_PtJakart.ml | 3 +++ devtools/get_contracts/get_contracts_alpha.ml | 3 +++ devtools/get_contracts/sigs.ml | 2 ++ 5 files changed, 18 insertions(+), 2 deletions(-) diff --git a/devtools/get_contracts/get_contracts.ml b/devtools/get_contracts/get_contracts.ml index e0e9d3eac529..1744e3e034dd 100644 --- a/devtools/get_contracts/get_contracts.ml +++ b/devtools/get_contracts/get_contracts.ml @@ -28,6 +28,8 @@ module Config = struct let collect_lambdas = true + let measure_code_size = true + let mainnet_genesis = { Genesis.time = Time.Protocol.of_notation_exn "2018-06-30T16:07:32Z"; @@ -360,7 +362,6 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct let* script_code = P.Translator.parse_code ctxt ~legacy:true @@ P.Script.lazy_expr script in - let size = Obj.(reachable_words @@ repr script_code) in File_helpers.print_expr_file ~dirname:output_dir ~ext:".tz" @@ -374,7 +375,11 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct "%a" (Format.pp_print_list ~pp_sep:Format.pp_print_newline P.Contract.pp) contracts ; - File_helpers.print_to_file (filename ~ext:"size") "%d words" size ; + File_helpers.print_to_file + (filename ~ext:"size") + "Expected: %d words@.Real: %d words" + (P.Translator.code_size script_code) + Obj.(reachable_words @@ repr script_code) ; return @@ if Config.collect_storage then diff --git a/devtools/get_contracts/get_contracts_012_Psithaca.ml b/devtools/get_contracts/get_contracts_012_Psithaca.ml index 6649f0370c35..d0e1db489990 100644 --- a/devtools/get_contracts/get_contracts_012_Psithaca.ml +++ b/devtools/get_contracts/get_contracts_012_Psithaca.ml @@ -67,6 +67,9 @@ module Proto = struct type ex_code = Script_ir_translator.ex_code + let code_size Script_ir_translator.(Ex_code {code_size; _}) = + Obj.magic code_size + let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = let open Result_syntax in diff --git a/devtools/get_contracts/get_contracts_013_PtJakart.ml b/devtools/get_contracts/get_contracts_013_PtJakart.ml index fc296b3b114a..2e6cab13eda7 100644 --- a/devtools/get_contracts/get_contracts_013_PtJakart.ml +++ b/devtools/get_contracts/get_contracts_013_PtJakart.ml @@ -67,6 +67,9 @@ module Proto = struct type ex_code = Script_ir_translator.ex_code + let code_size Script_ir_translator.(Ex_code (Code {code_size; _})) = + Obj.magic code_size + let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = let open Result_syntax in diff --git a/devtools/get_contracts/get_contracts_alpha.ml b/devtools/get_contracts/get_contracts_alpha.ml index 08fc001f7dc2..da1582127ac8 100644 --- a/devtools/get_contracts/get_contracts_alpha.ml +++ b/devtools/get_contracts/get_contracts_alpha.ml @@ -69,6 +69,9 @@ module Proto = struct type ex_code = Script_ir_translator.ex_code + let code_size Script_ir_translator.(Ex_code (Code {code_size; _})) = + Obj.magic code_size + let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = let open Result_syntax in diff --git a/devtools/get_contracts/sigs.ml b/devtools/get_contracts/sigs.ml index 531e793d3ed0..e956f5515f7e 100644 --- a/devtools/get_contracts/sigs.ml +++ b/devtools/get_contracts/sigs.ml @@ -96,6 +96,8 @@ module type PROTOCOL = sig type ex_code + val code_size : ex_code -> int + val parse_ty : context -> legacy:bool -> -- GitLab From 9c5386ddc854494dcfe879245596748580371814 Mon Sep 17 00:00:00 2001 From: Sventimir Date: Fri, 17 Jun 2022 09:35:53 +0200 Subject: [PATCH 4/6] Get_contracts: Gather raw contract data into a record. For easier processing and typing. --- devtools/get_contracts/get_contracts.ml | 33 ++++++++++++++----------- 1 file changed, 19 insertions(+), 14 deletions(-) diff --git a/devtools/get_contracts/get_contracts.ml b/devtools/get_contracts/get_contracts.ml index 1744e3e034dd..8a91327526c1 100644 --- a/devtools/get_contracts/get_contracts.ml +++ b/devtools/get_contracts/get_contracts.ml @@ -59,6 +59,12 @@ let mkdir dirname = module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct module ExprMap = Map.Make (P.Script.Hash) + type contract = { + script : P.Script.expr; + addresses : P.Contract.repr list; + storages : P.Script.expr ExprMap.t; + } + module File_helpers = struct let print_to_file ?err filename fmt = Format.kasprintf @@ -308,7 +314,7 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct in match code_opt with | None -> Lwt.return (m, i) (* Should not happen *) - | Some code -> + | Some script -> let+ add_storage = if Config.(collect_lambdas || collect_storage) then let+ storage_opt = @@ -326,18 +332,18 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct fun storages -> ExprMap.add key storage storages else Lwt.return (fun x -> x) in - let key = hash_expr code in + let key = hash_expr script in ( ExprMap.update key (fun existing -> let contracts, storages = match existing with - | Some (_code, contracts, storages) -> (contracts, storages) + | Some {addresses; storages; _} -> (addresses, storages) | None -> ([], ExprMap.empty) in - let contracts = contract :: contracts in + let addresses = contract :: contracts in let storages = add_storage storages in - Some (code, contracts, storages)) + Some {script; addresses; storages}) m, i ) end @@ -355,18 +361,17 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct let* _ctxt, values = P.Storage.list_values ctxt_i in List.fold_left_es (fun acc v -> f v acc) init values - let output_contract_results ctxt output_dir hash (script, contracts, storages) - = + let output_contract_results ctxt output_dir hash ctr = let open Lwt_result_syntax in let hash_string = P.Script.Hash.to_b58check hash in let* script_code = - P.Translator.parse_code ctxt ~legacy:true @@ P.Script.lazy_expr script + P.Translator.parse_code ctxt ~legacy:true @@ P.Script.lazy_expr ctr.script in File_helpers.print_expr_file ~dirname:output_dir ~ext:".tz" ~hash_string - script ; + ctr.script ; let filename ~ext = Filename.concat output_dir (Format.sprintf "%s.%s" hash_string ext) in @@ -374,17 +379,17 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct (filename ~ext:"address") "%a" (Format.pp_print_list ~pp_sep:Format.pp_print_newline P.Contract.pp) - contracts ; + ctr.addresses ; File_helpers.print_to_file (filename ~ext:"size") - "Expected: %d words@.Real: %d words" + "Expected: %d bytes@.Real: %d bytes" (P.Translator.code_size script_code) - Obj.(reachable_words @@ repr script_code) ; + (8 * Obj.(reachable_words @@ repr script_code)) ; return @@ if Config.collect_storage then let dirname = Filename.concat output_dir (hash_string ^ ".storage") in - File_helpers.print_expr_dir ~dirname ~ext:".storage" storages + File_helpers.print_expr_dir ~dirname ~ext:".storage" ctr.storages else () let main ~output_dir ctxt ~head : unit tzresult Lwt.t = @@ -422,7 +427,7 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct print_endline "Getting expressions from contracts..." ; let* exprs = ExprMap.fold_es - (fun hash (script, _contracts, storages) exprs -> + (fun hash {script; storages; _} exprs -> let exprs = ExprMap.add hash (script, false, ExprMap.empty) exprs in -- GitLab From 710f2febbc14c46267b13f75196eeccd107b4b16 Mon Sep 17 00:00:00 2001 From: Sventimir Date: Fri, 17 Jun 2022 09:59:17 +0200 Subject: [PATCH 5/6] Get_contracts: gather total IR size of all contracts. --- devtools/get_contracts/get_contracts.ml | 51 ++++++++++++++++++------- 1 file changed, 37 insertions(+), 14 deletions(-) diff --git a/devtools/get_contracts/get_contracts.ml b/devtools/get_contracts/get_contracts.ml index 8a91327526c1..f3281abbcc75 100644 --- a/devtools/get_contracts/get_contracts.ml +++ b/devtools/get_contracts/get_contracts.ml @@ -65,6 +65,16 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct storages : P.Script.expr ExprMap.t; } + type size_summary = {expected : int; actual : int} + + let zero_size = {expected = 0; actual = 0} + + let add_size ~expected_size ~actual_size summary = + { + expected = summary.expected + expected_size; + actual = summary.actual + actual_size; + } + module File_helpers = struct let print_to_file ?err filename fmt = Format.kasprintf @@ -361,7 +371,7 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct let* _ctxt, values = P.Storage.list_values ctxt_i in List.fold_left_es (fun acc v -> f v acc) init values - let output_contract_results ctxt output_dir hash ctr = + let output_contract_results ctxt output_dir hash ctr total_size = let open Lwt_result_syntax in let hash_string = P.Script.Hash.to_b58check hash in let* script_code = @@ -380,17 +390,24 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct "%a" (Format.pp_print_list ~pp_sep:Format.pp_print_newline P.Contract.pp) ctr.addresses ; - File_helpers.print_to_file - (filename ~ext:"size") - "Expected: %d bytes@.Real: %d bytes" - (P.Translator.code_size script_code) - (8 * Obj.(reachable_words @@ repr script_code)) ; - return - @@ - if Config.collect_storage then - let dirname = Filename.concat output_dir (hash_string ^ ".storage") in - File_helpers.print_expr_dir ~dirname ~ext:".storage" ctr.storages - else () + let expected_size, actual_size = + if Config.measure_code_size then ( + let expected = P.Translator.code_size script_code in + let actual = 8 * Obj.(reachable_words @@ repr script_code) in + File_helpers.print_to_file + (filename ~ext:"size") + "Expected: %d bytes@.Real: %d bytes@.%s@." + expected + actual + (if expected < actual then "WARNING: real size larger than expected!" + else "") ; + (expected, actual)) + else (0, 0) + in + (if Config.collect_storage then + let dirname = Filename.concat output_dir (hash_string ^ ".storage") in + File_helpers.print_expr_dir ~dirname ~ext:".storage" ctr.storages) ; + return @@ add_size ~expected_size ~actual_size total_size let main ~output_dir ctxt ~head : unit tzresult Lwt.t = let open Lwt_result_syntax in @@ -488,10 +505,16 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct else return (contract_map, (ExprMap.empty, ExprMap.empty, ExprMap.empty)) in print_endline "Writing contract files..." ; - let* () = - ExprMap.iter_es (output_contract_results ctxt output_dir) contract_map + let* total_ir_size = + ExprMap.fold_es + (output_contract_results ctxt output_dir) + contract_map + zero_size in print_endline "Done writing contract files." ; + if Config.measure_code_size then ( + Format.printf "Total measured IR size: %d bytes." total_ir_size.actual ; + Format.printf "Total expected IR size: %d bytes." total_ir_size.expected) ; let () = if not (ExprMap.is_empty lambda_map) then ( print_endline "Writing lambda files..." ; -- GitLab From 4ebb16bf734064afb9c17552e96065271f5a3499 Mon Sep 17 00:00:00 2001 From: Sventimir Date: Fri, 17 Jun 2022 10:19:45 +0200 Subject: [PATCH 6/6] Get_contracts: Extract contract size info into a module. --- devtools/get_contracts/contract_size.ml | 41 +++++++++++++++ devtools/get_contracts/dune | 2 +- devtools/get_contracts/get_contracts.ml | 52 +++++++++---------- .../get_contracts_012_Psithaca.ml | 5 +- .../get_contracts_013_PtJakart.ml | 6 ++- devtools/get_contracts/get_contracts_alpha.ml | 6 ++- devtools/get_contracts/sigs.ml | 4 +- manifest/main.ml | 2 +- 8 files changed, 84 insertions(+), 34 deletions(-) create mode 100644 devtools/get_contracts/contract_size.ml diff --git a/devtools/get_contracts/contract_size.ml b/devtools/get_contracts/contract_size.ml new file mode 100644 index 000000000000..77516a173378 --- /dev/null +++ b/devtools/get_contracts/contract_size.ml @@ -0,0 +1,41 @@ +(*****************************************************************************) +(* *) +(* Open Source License *) +(* Copyright (c) 2022 Nomadic Labs *) +(* *) +(* Permission is hereby granted, free of charge, to any person obtaining a *) +(* copy of this software and associated documentation files (the "Software"),*) +(* to deal in the Software without restriction, including without limitation *) +(* the rights to use, copy, modify, merge, publish, distribute, sublicense, *) +(* and/or sell copies of the Software, and to permit persons to whom the *) +(* Software is furnished to do so, subject to the following conditions: *) +(* *) +(* The above copyright notice and this permission notice shall be included *) +(* in all copies or substantial portions of the Software. *) +(* *) +(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*) +(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, *) +(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL *) +(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*) +(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING *) +(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER *) +(* DEALINGS IN THE SOFTWARE. *) +(* *) +(*****************************************************************************) + +type t = {expected : int; actual : int} + +let zero = {expected = 0; actual = 0} + +let add a b = {expected = a.expected + b.expected; actual = a.actual + b.actual} + +let pp fmt {expected; actual} = + Format.fprintf fmt "Expected size: %d bytes@\n" expected ; + Format.fprintf fmt "Real measured size: %d bytes@\n" actual ; + if actual > expected then + let diff = actual - expected in + let percentage = 100.0 *. float_of_int diff /. float_of_int expected in + Format.fprintf + fmt + "WARNING: Real size exceeds expectation by %.2f%%!@\n" + percentage diff --git a/devtools/get_contracts/dune b/devtools/get_contracts/dune index 3541cef76574..68747a00bceb 100644 --- a/devtools/get_contracts/dune +++ b/devtools/get_contracts/dune @@ -14,7 +14,7 @@ -open Tezos_micheline -open Tezos_base.TzPervasives -open Tezos_stdlib_unix) - (modules get_contracts sigs storage_helpers)) + (modules get_contracts sigs storage_helpers contract_size)) (executable (name get_contracts_012_Psithaca) diff --git a/devtools/get_contracts/get_contracts.ml b/devtools/get_contracts/get_contracts.ml index f3281abbcc75..9367aa306223 100644 --- a/devtools/get_contracts/get_contracts.ml +++ b/devtools/get_contracts/get_contracts.ml @@ -65,16 +65,6 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct storages : P.Script.expr ExprMap.t; } - type size_summary = {expected : int; actual : int} - - let zero_size = {expected = 0; actual = 0} - - let add_size ~expected_size ~actual_size summary = - { - expected = summary.expected + expected_size; - actual = summary.actual + actual_size; - } - module File_helpers = struct let print_to_file ?err filename fmt = Format.kasprintf @@ -374,9 +364,6 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct let output_contract_results ctxt output_dir hash ctr total_size = let open Lwt_result_syntax in let hash_string = P.Script.Hash.to_b58check hash in - let* script_code = - P.Translator.parse_code ctxt ~legacy:true @@ P.Script.lazy_expr ctr.script - in File_helpers.print_expr_file ~dirname:output_dir ~ext:".tz" @@ -390,24 +377,31 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct "%a" (Format.pp_print_list ~pp_sep:Format.pp_print_newline P.Contract.pp) ctr.addresses ; - let expected_size, actual_size = + let* contract_size = if Config.measure_code_size then ( - let expected = P.Translator.code_size script_code in - let actual = 8 * Obj.(reachable_words @@ repr script_code) in + let* script_code = + P.Translator.parse_code ctxt ~legacy:true + @@ P.Script.lazy_expr ctr.script + in + let size = + Contract_size. + { + expected = P.Translator.expected_code_size script_code; + actual = P.Translator.actual_code_size script_code; + } + in File_helpers.print_to_file (filename ~ext:"size") - "Expected: %d bytes@.Real: %d bytes@.%s@." - expected - actual - (if expected < actual then "WARNING: real size larger than expected!" - else "") ; - (expected, actual)) - else (0, 0) + "%a" + Contract_size.pp + size ; + return size) + else return Contract_size.zero in (if Config.collect_storage then let dirname = Filename.concat output_dir (hash_string ^ ".storage") in File_helpers.print_expr_dir ~dirname ~ext:".storage" ctr.storages) ; - return @@ add_size ~expected_size ~actual_size total_size + return @@ Contract_size.add contract_size total_size let main ~output_dir ctxt ~head : unit tzresult Lwt.t = let open Lwt_result_syntax in @@ -509,12 +503,14 @@ module Make (P : Sigs.PROTOCOL) : Sigs.MAIN = struct ExprMap.fold_es (output_contract_results ctxt output_dir) contract_map - zero_size + Contract_size.zero in print_endline "Done writing contract files." ; - if Config.measure_code_size then ( - Format.printf "Total measured IR size: %d bytes." total_ir_size.actual ; - Format.printf "Total expected IR size: %d bytes." total_ir_size.expected) ; + if Config.measure_code_size then + Format.printf + "@[Total IR size:@;%a@]@." + Contract_size.pp + total_ir_size ; let () = if not (ExprMap.is_empty lambda_map) then ( print_endline "Writing lambda files..." ; diff --git a/devtools/get_contracts/get_contracts_012_Psithaca.ml b/devtools/get_contracts/get_contracts_012_Psithaca.ml index d0e1db489990..dd9af043782b 100644 --- a/devtools/get_contracts/get_contracts_012_Psithaca.ml +++ b/devtools/get_contracts/get_contracts_012_Psithaca.ml @@ -67,9 +67,12 @@ module Proto = struct type ex_code = Script_ir_translator.ex_code - let code_size Script_ir_translator.(Ex_code {code_size; _}) = + let expected_code_size Script_ir_translator.(Ex_code {code_size; _}) = Obj.magic code_size + let actual_code_size Script_ir_translator.(Ex_code {code; _}) = + 8 * Obj.(reachable_words @@ repr code) + let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = let open Result_syntax in diff --git a/devtools/get_contracts/get_contracts_013_PtJakart.ml b/devtools/get_contracts/get_contracts_013_PtJakart.ml index 2e6cab13eda7..24bc0f5bebb9 100644 --- a/devtools/get_contracts/get_contracts_013_PtJakart.ml +++ b/devtools/get_contracts/get_contracts_013_PtJakart.ml @@ -67,9 +67,13 @@ module Proto = struct type ex_code = Script_ir_translator.ex_code - let code_size Script_ir_translator.(Ex_code (Code {code_size; _})) = + let expected_code_size Script_ir_translator.(Ex_code (Code {code_size; _})) + = Obj.magic code_size + let actual_code_size Script_ir_translator.(Ex_code (Code {code; _})) = + 8 * Obj.(reachable_words @@ repr code) + let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = let open Result_syntax in diff --git a/devtools/get_contracts/get_contracts_alpha.ml b/devtools/get_contracts/get_contracts_alpha.ml index da1582127ac8..75ba10925c0a 100644 --- a/devtools/get_contracts/get_contracts_alpha.ml +++ b/devtools/get_contracts/get_contracts_alpha.ml @@ -69,9 +69,13 @@ module Proto = struct type ex_code = Script_ir_translator.ex_code - let code_size Script_ir_translator.(Ex_code (Code {code_size; _})) = + let expected_code_size Script_ir_translator.(Ex_code (Code {code_size; _})) + = Obj.magic code_size + let actual_code_size Script_ir_translator.(Ex_code (Code {code; _})) = + 8 * Obj.(reachable_words @@ repr code) + let parse_ty (ctxt : Raw_context.t) ~legacy ~allow_lazy_storage ~allow_operation ~allow_contract ~allow_ticket script = let open Result_syntax in diff --git a/devtools/get_contracts/sigs.ml b/devtools/get_contracts/sigs.ml index e956f5515f7e..9bf9b4d0a075 100644 --- a/devtools/get_contracts/sigs.ml +++ b/devtools/get_contracts/sigs.ml @@ -96,7 +96,9 @@ module type PROTOCOL = sig type ex_code - val code_size : ex_code -> int + val actual_code_size : ex_code -> int + + val expected_code_size : ex_code -> int val parse_ty : context -> diff --git a/manifest/main.ml b/manifest/main.ml index 8966dc596dd4..e668f8d1e94e 100644 --- a/manifest/main.ml +++ b/manifest/main.ml @@ -4614,7 +4614,7 @@ let get_contracts_lib = octez_client_base_unix; octez_store; ] - ~modules:["get_contracts"; "sigs"; "storage_helpers"] + ~modules:["get_contracts"; "sigs"; "storage_helpers"; "contract_size"] ~static:false ~release:false ~bisect_ppx:false -- GitLab