Michelson: fix gas costs for PACK/UNPACK
This commit is contained in:
parent
79b4767370
commit
33e6d89ce9
@ -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
|
||||
|
@ -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
|
||||
|
@ -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) ->
|
||||
|
Loading…
Reference in New Issue
Block a user