From 7159b92cbdf9302bbac2e3892284603d70a97f1a Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Thu, 28 Jun 2018 19:03:19 +0200 Subject: [PATCH] Michelson: gas costs tweaks and fixes --- .../lib_protocol/src/michelson_v1_gas.ml | 46 +++++++++---------- .../lib_protocol/src/michelson_v1_gas.mli | 5 +- .../lib_protocol/src/script_ir_translator.ml | 6 ++- 3 files changed, 29 insertions(+), 28 deletions(-) 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 1681254ca..938b75c56 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml @@ -57,7 +57,7 @@ module Cost_of = struct let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost = fun (module Box) -> let size = snd Box.boxed in - 2 *@ (alloc_cost (size * 2)) + 3 *@ alloc_cost size let map_mem _key map = step_cost (map_access map) @@ -85,10 +85,13 @@ module Cost_of = struct let wrap = alloc_cost 1 let mul n1 n2 = - let bits = + let steps = (Z.numbits (Script_int.to_zint n1)) * (Z.numbits (Script_int.to_zint n2)) in - step_cost bits +@ alloc_bits_cost bits + let bits = + (Z.numbits (Script_int.to_zint n1)) + + (Z.numbits (Script_int.to_zint n2)) in + step_cost steps +@ alloc_bits_cost bits let div n1 n2 = mul n1 n2 +@ alloc_cost 2 @@ -171,24 +174,21 @@ module Cost_of = struct let unpack bytes = 10 *@ step_cost (MBytes.length bytes) let pack bytes = alloc_bytes_cost (MBytes.length bytes) - (* TODO: protocol operations *) - let address = step_cost 3 - let contract = Gas.read_bytes_cost Z.zero +@ step_cost 3 - let manager = step_cost 3 - let transfer = step_cost 50 - let create_account = step_cost 20 - let create_contract = step_cost 70 + let address = step_cost 1 + let contract = Gas.read_bytes_cost Z.zero +@ step_cost 100 + let transfer = step_cost 10 + let create_account = step_cost 10 + let create_contract = step_cost 10 let implicit_account = step_cost 10 - let set_delegate = step_cost 10 - let balance = step_cost 5 - let now = step_cost 3 - let check_signature = step_cost 3 - let hash_key = step_cost 3 - (* TODO: This needs to be a function of the data being hashed *) - let hash data len = step_cost (MBytes.length data) +@ alloc_bytes_cost len + let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32) + let balance = step_cost 1 +@ read_bytes_cost (Z.of_int 8) + let now = step_cost 5 + let check_signature = step_cost 100 + let hash_key = step_cost 3 +@ bytes 20 + let hash data len = 10 *@ step_cost (MBytes.length data) +@ bytes len let steps_to_quota = step_cost 1 - let source = step_cost 3 - let self = step_cost 3 + let source = step_cost 1 + let self = step_cost 1 let amount = step_cost 1 let compare_bool _ _ = step_cost 1 let compare_string s1 s2 = @@ -225,8 +225,8 @@ module Cost_of = struct let some = alloc_cost 1 let none = alloc_cost 0 let list_element = alloc_cost 2 +@ step_cost 1 - let set_element = alloc_cost 3 +@ step_cost 2 - let map_element = alloc_cost 4 +@ step_cost 2 + let set_element size = log2 size *@ (alloc_cost 3 +@ step_cost 2) + let map_element size = log2 size *@ (alloc_cost 4 +@ step_cost 2) let primitive_type = alloc_cost 1 let one_arg_type = alloc_cost 2 let two_arg_type = alloc_cost 3 @@ -379,8 +379,8 @@ module Cost_of = struct 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 set_element = alloc_cost 2 + let map_element = alloc_cost 2 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 50eaec770..8e546b139 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli @@ -68,7 +68,6 @@ module Cost_of : sig val unpack : MBytes.t -> Gas.cost val address : Gas.cost val contract : Gas.cost - val manager : Gas.cost val transfer : Gas.cost val create_account : Gas.cost val create_contract : Gas.cost @@ -125,8 +124,8 @@ module Cost_of : sig val none : Gas.cost val list_element : Gas.cost - val set_element : Gas.cost - val map_element : Gas.cost + val set_element : int -> Gas.cost + val map_element : int -> Gas.cost val primitive_type : Gas.cost val one_arg_type : Gas.cost 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 caa98f144..a6586e27f 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -1243,9 +1243,10 @@ let rec parse_data let traced body = trace error body in let parse_items ?type_logger loc ctxt expr key_type value_type items item_wrapper = + let length = List.length items in fold_left_s (fun (last_value, map, ctxt) item -> - Lwt.return (Gas.consume ctxt Typecheck_costs.cycle) >>=? fun ctxt -> + Lwt.return (Gas.consume ctxt (Typecheck_costs.map_element length)) >>=? fun ctxt -> match item with | Prim (_, D_Elt, [ k; v ], _) -> parse_comparable_data ?type_logger ctxt key_type k >>=? fun (k, ctxt) -> @@ -1498,10 +1499,11 @@ let rec parse_data traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr))) (* Sets *) | Set_t (t, _ty_name), (Seq (loc, vs) as expr) -> + let length = List.length vs in traced @@ fold_left_s (fun (last_value, set, ctxt) v -> - Lwt.return (Gas.consume ctxt Typecheck_costs.set_element) >>=? fun ctxt -> + Lwt.return (Gas.consume ctxt (Typecheck_costs.set_element length)) >>=? fun ctxt -> parse_comparable_data ?type_logger ctxt t v >>=? fun (v, ctxt) -> begin match last_value with | Some value ->