diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 668758e35..51f6332f2 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -301,6 +301,16 @@ module Script : sig val lazy_expr_encoding: lazy_expr Data_encoding.t val deserialized_cost : expr -> Gas.cost val serialized_cost : MBytes.t -> Gas.cost + val int_node_cost : Z.t -> Gas.cost + val int_node_cost_of_numbits : int -> Gas.cost + val string_node_cost : string -> Gas.cost + val string_node_cost_of_length : int -> Gas.cost + val bytes_node_cost : MBytes.t -> Gas.cost + val bytes_node_cost_of_length : int -> Gas.cost + val prim_node_cost_nonrec : expr list -> annot -> Gas.cost + val prim_node_cost_nonrec_of_length : int -> annot -> Gas.cost + val seq_node_cost_nonrec : expr list -> Gas.cost + val seq_node_cost_nonrec_of_length : int -> Gas.cost val force_decode : lazy_expr -> (expr * Gas.cost) tzresult val force_bytes : lazy_expr -> (MBytes.t * Gas.cost) tzresult val minimal_deserialize_cost : lazy_expr -> Gas.cost diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml index b58135789..1681254ca 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml @@ -10,9 +10,6 @@ open Alpha_context open Gas -(* FIXME: this really is a preliminary estimation of costs, - everything in this file needs to be tweaked and proofread. *) - module Cost_of = struct let cycle = step_cost 1 let nop = free @@ -34,6 +31,9 @@ module Cost_of = struct let string length = alloc_bytes_cost length + let bytes length = + alloc_cost 12 +@ alloc_bytes_cost length + let concat s1 s2 = string (String.length s1 + String.length s2) @@ -208,6 +208,7 @@ module Cost_of = struct let bool = free let unit = free let string = string + let bytes = bytes let int_of_string str = alloc_cost @@ (Pervasives.(/) (String.length str) 5) let tez = step_cost 1 +@ alloc_cost 1 @@ -229,10 +230,7 @@ module Cost_of = struct let primitive_type = alloc_cost 1 let one_arg_type = alloc_cost 2 let two_arg_type = alloc_cost 3 - let operation b = - (* TODO: proper handling of (de)serialization costs *) - let len = MBytes.length b in - alloc_cost len +@ step_cost (len * 10) + let operation b = bytes b let type_ nb_args = alloc_cost (nb_args + 1) let instr @@ -356,41 +354,33 @@ module Cost_of = struct end module Unparse = struct - let prim_cost nb_args = - alloc_cost 4 (* location, primitive name, list, annotation *) +@ - (nb_args *@ alloc_cost 2) - let seq_cost nb_args = - alloc_cost 2 (* location, list *) +@ - (nb_args *@ alloc_cost 2) - let string_cost length = - alloc_cost 3 +@ alloc_bytes_cost length + let prim_cost l annot = Script.prim_node_cost_nonrec_of_length l annot + let seq_cost = Script.seq_node_cost_nonrec_of_length + let string_cost length = Script.string_node_cost_of_length length let cycle = step_cost 1 - let bool = prim_cost 0 - let unit = prim_cost 0 - (* FIXME: not sure we should count the length of strings and bytes - as they are shared *) - let string s = string_cost (String.length s) - let bytes s = alloc_bytes_cost (MBytes.length s) - (* Approximates log10(x) *) - let z i = - let decimal_digits = (Z.numbits (Z.abs i)) / 4 in - prim_cost 0 +@ (alloc_bytes_cost decimal_digits) - let int i = z (Script_int.to_zint i) - let tez = string_cost 19 (* max length of 64 bit int *) + let bool = prim_cost 0 [] + let unit = prim_cost 0 [] + (* We count the length of strings and bytes to prevent hidden + miscalculations due to non detectable expansion of sharing. *) + let string s = Script.string_node_cost s + let bytes s = Script.bytes_node_cost s + let z i = Script.int_node_cost i + let int i = Script.int_node_cost (Script_int.to_zint i) + let tez = Script.int_node_cost_of_numbits 60 (* int64 bound *) let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int - let operation bytes = string_cost (MBytes.length bytes * 2) + let operation bytes = Script.bytes_node_cost bytes let key = string_cost 54 let key_hash = string_cost 36 let signature = string_cost 128 let contract = string_cost 36 - let pair = prim_cost 2 - let union = prim_cost 1 - let some = prim_cost 1 - let none = prim_cost 0 - let list_element = prim_cost 1 - let set_element = alloc_cost 2 - let map_element = alloc_cost 2 + let pair = prim_cost 2 [] + let union = prim_cost 1 [] + let some = prim_cost 1 [] + let none = prim_cost 0 [] + let list_element = alloc_cost 2 + let set_element = alloc_cost 2 (* FIXME: log(size) *) + let map_element = alloc_cost 2 (* FIXME: log(size) *) let one_arg_type = prim_cost 1 let two_arg_type = prim_cost 2 diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli index 752b8af6f..50eaec770 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli @@ -100,6 +100,7 @@ module Cost_of : sig val bool : Gas.cost val tez : Gas.cost val string : int -> Gas.cost + val bytes : int -> Gas.cost val int_of_string : string -> Gas.cost val string_timestamp : Gas.cost val key : Gas.cost @@ -131,7 +132,7 @@ module Cost_of : sig val one_arg_type : Gas.cost val two_arg_type : Gas.cost - val operation : MBytes.t -> Gas.cost + val operation : int -> Gas.cost (** Cost of parsing a type *) val type_ : int -> Gas.cost @@ -141,7 +142,7 @@ module Cost_of : sig end module Unparse : sig - val prim_cost : int -> Gas.cost + val prim_cost : int -> Script.annot -> Gas.cost val seq_cost : int -> Gas.cost val cycle : Gas.cost val unit : Gas.cost @@ -171,8 +172,8 @@ module Cost_of : sig val set_element : Gas.cost val map_element : Gas.cost - val one_arg_type : Gas.cost - val two_arg_type : Gas.cost + val one_arg_type : Script.annot -> Gas.cost + val two_arg_type : Script.annot -> Gas.cost val set_to_list : 'a Script_typed_ir.set -> Gas.cost val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost end diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index 89f4d4cb0..a3e3f51f9 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -547,7 +547,7 @@ let rec unparse_ty_no_lwt Gas.consume ctxt Unparse_costs.cycle >>? fun ctxt -> let return ctxt (name, args, annot) = let result = Prim (-1, name, args, annot) in - Gas.consume ctxt (Unparse_costs.prim_cost (List.length args)) >>? fun ctxt -> + Gas.consume ctxt (Unparse_costs.prim_cost (List.length args) annot) >>? fun ctxt -> ok (result, ctxt) in match ty with | Unit_t tname -> return ctxt (T_unit, [], unparse_type_annot tname) diff --git a/src/proto_alpha/lib_protocol/src/script_repr.ml b/src/proto_alpha/lib_protocol/src/script_repr.ml index d0f0d2948..2ea02302c 100644 --- a/src/proto_alpha/lib_protocol/src/script_repr.ml +++ b/src/proto_alpha/lib_protocol/src/script_repr.ml @@ -57,29 +57,53 @@ let encoding = (req "code" lazy_expr_encoding) (req "storage" lazy_expr_encoding)) +let int_node_size_of_numbits n = + (1, 1 + (n + 63) / 64) +let int_node_size n = + int_node_size_of_numbits (Z.numbits n) +let string_node_size_of_length s = + (1, 1 + (s + 7) / 8) +let string_node_size s = + string_node_size_of_length (String.length s) +let bytes_node_size_of_length s = + (* approx cost of indirection to the C heap *) + (2, 1 + (s + 7) / 8 + 12) +let bytes_node_size s = + bytes_node_size_of_length (MBytes.length s) +let prim_node_size_nonrec_of_lengths n_args annots = + let annots_length = List.fold_left (fun acc s -> acc + String.length s) 0 annots in + if Compare.Int.(annots_length = 0) then + (1 + n_args, 2 + 2 * n_args) + else + (2 + n_args, 4 + 2 * n_args + (annots_length + 7) / 8) +let prim_node_size_nonrec args annots = + let n_args = List.length args in + prim_node_size_nonrec_of_lengths n_args annots +let seq_node_size_nonrec_of_length n_args = + (1 + n_args, 2 + 2 * n_args) +let seq_node_size_nonrec args = + let n_args = List.length args in + seq_node_size_nonrec_of_length n_args + let rec node_size node = let open Micheline in match node with - | Int (_, n) -> (1, 1 + (Z.numbits n + 63) / 64) - | String (_, s) -> (1, 1 + (String.length s + 7) / 8) - | Bytes (_, s) -> (1, 1 + (MBytes.length s + 7) / 8) + | Int (_, n) -> int_node_size n + | String (_, s) -> string_node_size s + | Bytes (_, s) -> bytes_node_size s | Prim (_, _, args, annot) -> List.fold_left (fun (blocks, words) node -> let (nblocks, nwords) = node_size node in - (blocks + 1 + nblocks, words + 2 + nwords)) - (match annot with - | [] -> (1, 2) - | annots -> - let annots_length = List.fold_left (fun acc s -> acc + String.length s) 0 annots in - (1, 4 + (annots_length + 7) / 8)) + (blocks + nblocks, words + nwords)) + (prim_node_size_nonrec args annot) args | Seq (_, args) -> List.fold_left (fun (blocks, words) node -> let (nblocks, nwords) = node_size node in - (blocks + 1 + nblocks, words + 2 + nwords)) - (1, 2) + (blocks + nblocks, words + nwords)) + (seq_node_size_nonrec args) args let expr_size expr = @@ -89,13 +113,26 @@ let traversal_cost expr = let blocks, _words = expr_size expr in Gas_limit_repr.step_cost blocks -let deserialized_cost expr = +let node_cost (blocks, words) = let open Gas_limit_repr in - let blocks, words = expr_size expr in ((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@ alloc_cost words +@ step_cost blocks +let int_node_cost n = node_cost (int_node_size n) +let int_node_cost_of_numbits n = node_cost (int_node_size_of_numbits n) +let string_node_cost s = node_cost (string_node_size s) +let string_node_cost_of_length s = node_cost (string_node_size_of_length s) +let bytes_node_cost s = node_cost (bytes_node_size s) +let bytes_node_cost_of_length s = node_cost (bytes_node_size_of_length s) +let prim_node_cost_nonrec args annot = node_cost (prim_node_size_nonrec args annot) +let prim_node_cost_nonrec_of_length n_args annot = node_cost (prim_node_size_nonrec_of_lengths n_args annot) +let seq_node_cost_nonrec args = node_cost (seq_node_size_nonrec args) +let seq_node_cost_nonrec_of_length n_args = node_cost (seq_node_size_nonrec_of_length n_args) + +let deserialized_cost expr = + node_cost (expr_size expr) + let serialized_cost bytes = let open Gas_limit_repr in alloc_bytes_cost (MBytes.length bytes) diff --git a/src/proto_alpha/lib_protocol/src/script_repr.mli b/src/proto_alpha/lib_protocol/src/script_repr.mli index eb319a201..fc2badf50 100644 --- a/src/proto_alpha/lib_protocol/src/script_repr.mli +++ b/src/proto_alpha/lib_protocol/src/script_repr.mli @@ -35,6 +35,17 @@ val deserialized_cost : expr -> Gas_limit_repr.cost val serialized_cost : MBytes.t -> Gas_limit_repr.cost +val int_node_cost : Z.t -> Gas_limit_repr.cost +val int_node_cost_of_numbits : int -> Gas_limit_repr.cost +val string_node_cost : string -> Gas_limit_repr.cost +val string_node_cost_of_length : int -> Gas_limit_repr.cost +val bytes_node_cost : MBytes.t -> Gas_limit_repr.cost +val bytes_node_cost_of_length : int -> Gas_limit_repr.cost +val prim_node_cost_nonrec : expr list -> annot -> Gas_limit_repr.cost +val prim_node_cost_nonrec_of_length : int -> annot -> Gas_limit_repr.cost +val seq_node_cost_nonrec : expr list -> Gas_limit_repr.cost +val seq_node_cost_nonrec_of_length : int -> Gas_limit_repr.cost + val force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult val force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult