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 compare_res = step_cost 1
|
||||||
|
|
||||||
let unpack bytes = 10 *@ step_cost (MBytes.length bytes)
|
let unpack_failed bytes =
|
||||||
let pack bytes = alloc_bytes_cost (MBytes.length 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 address = step_cost 1
|
||||||
let contract = Gas.read_bytes_cost Z.zero +@ step_cost 100
|
let contract = Gas.read_bytes_cost Z.zero +@ step_cost 100
|
||||||
|
@ -64,8 +64,7 @@ module Cost_of : sig
|
|||||||
val exec : Gas.cost
|
val exec : Gas.cost
|
||||||
val push : Gas.cost
|
val push : Gas.cost
|
||||||
val compare_res : Gas.cost
|
val compare_res : Gas.cost
|
||||||
val pack : MBytes.t -> Gas.cost
|
val unpack_failed : MBytes.t -> Gas.cost
|
||||||
val unpack : MBytes.t -> Gas.cost
|
|
||||||
val address : Gas.cost
|
val address : Gas.cost
|
||||||
val contract : Gas.cost
|
val contract : Gas.cost
|
||||||
val transfer : Gas.cost
|
val transfer : Gas.cost
|
||||||
|
@ -641,13 +641,18 @@ let rec interp
|
|||||||
Script_ir_translator.pack_data ctxt t value >>=? fun (bytes, ctxt) ->
|
Script_ir_translator.pack_data ctxt t value >>=? fun (bytes, ctxt) ->
|
||||||
logged_return (Item (bytes, rest), ctxt)
|
logged_return (Item (bytes, rest), ctxt)
|
||||||
| Unpack t, Item (bytes, rest) ->
|
| Unpack t, Item (bytes, rest) ->
|
||||||
Lwt.return (Gas.consume ctxt (Interp_costs.pack bytes)) >>=? fun ctxt ->
|
begin match Data_encoding.Binary.of_bytes Script.lazy_expr_encoding bytes with
|
||||||
begin match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with
|
|
||||||
| None ->
|
| None ->
|
||||||
|
Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->
|
||||||
logged_return (Item (None, rest), ctxt)
|
logged_return (Item (None, rest), ctxt)
|
||||||
| Some expr ->
|
| Some lexpr ->
|
||||||
parse_data ctxt t (Micheline.root expr) >>=? fun (value, ctxt) ->
|
(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)
|
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
|
end
|
||||||
(* protocol *)
|
(* protocol *)
|
||||||
| Address, Item ((_, contract), rest) ->
|
| Address, Item ((_, contract), rest) ->
|
||||||
|
Loading…
Reference in New Issue
Block a user