Michelson: fix gas costs for PACK/UNPACK

This commit is contained in:
Benjamin Canou 2018-06-29 23:46:42 +02:00
parent 79b4767370
commit 33e6d89ce9
3 changed files with 17 additions and 9 deletions

View File

@ -174,8 +174,12 @@ module Cost_of = struct
let compare_res = step_cost 1
let unpack bytes = 10 *@ step_cost (MBytes.length bytes)
let pack bytes = alloc_bytes_cost (MBytes.length bytes)
let unpack_failed bytes =
(* We cannot instrument failed deserialization,
so we take worst case fees: a set of size 1 bytes values. *)
let len = MBytes.length bytes in
(len *@ alloc_mbytes_cost 1) +@
(len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))
let address = step_cost 1
let contract = Gas.read_bytes_cost Z.zero +@ step_cost 100

View File

@ -64,8 +64,7 @@ module Cost_of : sig
val exec : Gas.cost
val push : Gas.cost
val compare_res : Gas.cost
val pack : MBytes.t -> Gas.cost
val unpack : MBytes.t -> Gas.cost
val unpack_failed : MBytes.t -> Gas.cost
val address : Gas.cost
val contract : Gas.cost
val transfer : Gas.cost

View File

@ -641,13 +641,18 @@ let rec interp
Script_ir_translator.pack_data ctxt t value >>=? fun (bytes, ctxt) ->
logged_return (Item (bytes, rest), ctxt)
| Unpack t, Item (bytes, rest) ->
Lwt.return (Gas.consume ctxt (Interp_costs.pack bytes)) >>=? fun ctxt ->
begin match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with
begin match Data_encoding.Binary.of_bytes Script.lazy_expr_encoding bytes with
| None ->
Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->
logged_return (Item (None, rest), ctxt)
| Some expr ->
parse_data ctxt t (Micheline.root expr) >>=? fun (value, ctxt) ->
logged_return (Item (Some value, rest), ctxt)
| Some lexpr ->
(Script.force_decode ctxt lexpr >>=? fun (expr, ctxt) ->
parse_data ctxt t (Micheline.root expr)) >>= function
| Ok (value, ctxt) ->
logged_return (Item (Some value, rest), ctxt)
| Error _ignored ->
Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->
logged_return (Item (None, rest), ctxt)
end
(* protocol *)
| Address, Item ((_, contract), rest) ->