diff --git a/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL b/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL
index 0cdbcf4b2..170e27dba 100644
--- a/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL
+++ b/src/proto_alpha/lib_protocol/src/TEZOS_PROTOCOL
@@ -52,11 +52,11 @@
         "Vote_storage",
         "Commitment_storage",
         "Init_storage",
+        "Fees",
 
         "Alpha_context",
 
         "Script_typed_ir",
-        "Fees",
         "Script_tc_errors",
         "Michelson_v1_gas",
         "Script_ir_annot",
diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.ml b/src/proto_alpha/lib_protocol/src/alpha_context.ml
index 61fab4c22..8c658952c 100644
--- a/src/proto_alpha/lib_protocol/src/alpha_context.ml
+++ b/src/proto_alpha/lib_protocol/src/alpha_context.ml
@@ -54,6 +54,7 @@ module Script = struct
   include Michelson_v1_primitives
   include Script_repr
 end
+module Fees = Fees
 
 type public_key = Signature.Public_key.t
 type public_key_hash = Signature.Public_key_hash.t
diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli
index 8f2a6aa39..01f49e188 100644
--- a/src/proto_alpha/lib_protocol/src/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli
@@ -578,8 +578,6 @@ module Contract : sig
   val set_storage_unlimited: context -> context
 
   val used_storage_space: context -> t -> Z.t tzresult Lwt.t
-  val paid_storage_space_fees: context -> t -> Tez.t tzresult Lwt.t
-  val pay_for_storage_space: context -> t -> Tez.t -> context tzresult Lwt.t
 
   val increment_counter:
     context -> contract -> context tzresult Lwt.t
@@ -895,6 +893,21 @@ type packed_internal_operation =
 
 val manager_kind: 'kind manager_operation -> 'kind Kind.manager
 
+module Fees : sig
+
+  val origination_burn:
+    context -> payer:Contract.t -> (context * Tez.t) tzresult Lwt.t
+
+  val record_paid_storage_space:
+    context -> Contract.t -> (context * Z.t * Tez.t) tzresult Lwt.t
+
+  val with_fees_for_storage:
+    context -> payer:Contract.t ->
+    (context -> (context * 'a) tzresult Lwt.t) ->
+    (context * 'a) tzresult Lwt.t
+
+end
+
 module Operation : sig
 
   type nonrec 'kind contents = 'kind contents
diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml
index 25ea10ad5..e980b0053 100644
--- a/src/proto_alpha/lib_protocol/src/apply.ml
+++ b/src/proto_alpha/lib_protocol/src/apply.ml
@@ -398,8 +398,8 @@ let apply_manager_operation_content :
             Contract.used_storage_space ctxt destination >>=? fun old_size ->
             Contract.update_script_storage
               ctxt destination storage big_map_diff >>=? fun ctxt ->
-            Fees.update_script_storage
-              ctxt ~payer destination >>=? fun (ctxt, new_size, fees) ->
+            Fees.record_paid_storage_space
+              ctxt destination >>=? fun (ctxt, new_size, fees) ->
             Contract.originated_from_current_nonce
               ~since: before_operation
               ~until: ctxt >>=? fun originated_contracts ->
@@ -440,12 +440,14 @@ let apply_manager_operation_content :
           ~manager ~delegate ~balance:credit
           ?script
           ~spendable ~delegatable >>=? fun ctxt ->
-        Fees.origination_burn ctxt ~payer contract >>=? fun (ctxt, size, fees) ->
+        Fees.origination_burn ctxt ~payer >>=? fun (ctxt, orignation_burn) ->
+        Fees.record_paid_storage_space ctxt contract >>=? fun (ctxt, size, fees) ->
+        Lwt.return Tez.(orignation_burn +? fees) >>=? fun all_fees ->
         let result =
           Origination_result
             { balance_updates =
                 cleanup_balance_updates
-                  [ Contract payer, Debited fees ;
+                  [ Contract payer, Debited all_fees ;
                     Contract source, Debited credit ;
                     Contract contract, Credited credit ] ;
               originated_contracts = [ contract ] ;
@@ -516,22 +518,24 @@ let apply_manager_contents
   Lwt.return (Gas.set_limit ctxt gas_limit) >>=? fun ctxt ->
   Lwt.return (Contract.set_storage_limit ctxt storage_limit) >>=? fun ctxt ->
   let level = Level.current ctxt in
-  apply_manager_operation_content ctxt mode
-    ~source ~payer:source ~internal:false operation >>= begin function
-    | Ok (ctxt, operation_results, internal_operations) -> begin
-        apply_internal_manager_operations
-          ctxt mode ~payer:source internal_operations >>= function
-        | Ok (ctxt, internal_operations_results) ->
-            return (ctxt,
-                    Applied operation_results, internal_operations_results)
-        | Error internal_operations_results ->
-            return (ctxt (* backtracked *),
-                    Applied operation_results, internal_operations_results)
-      end
-    | Error operation_results ->
-        return (ctxt (* backtracked *),
-                Failed (manager_kind operation, operation_results), [])
-  end >>=? fun (ctxt, operation_result, internal_operation_results) ->
+  Fees.with_fees_for_storage ctxt ~payer:source begin fun ctxt ->
+    apply_manager_operation_content ctxt mode
+      ~source ~payer:source ~internal:false operation >>= begin function
+      | Ok (ctxt, operation_results, internal_operations) -> begin
+          apply_internal_manager_operations
+            ctxt mode ~payer:source internal_operations >>= function
+          | Ok (ctxt, internal_operations_results) ->
+              return (ctxt,
+                      (Applied operation_results, internal_operations_results))
+          | Error internal_operations_results ->
+              return (ctxt (* backtracked *),
+                      (Applied operation_results, internal_operations_results))
+        end
+      | Error operation_results ->
+          return (ctxt (* backtracked *),
+                  (Failed (manager_kind operation, operation_results), []))
+    end
+  end >>=? fun (ctxt, (operation_result, internal_operation_results)) ->
   return (ctxt,
           Manager_operation_result
             { balance_updates =
diff --git a/src/proto_alpha/lib_protocol/src/constants_repr.ml b/src/proto_alpha/lib_protocol/src/constants_repr.ml
index 4e5fb272d..72b6b38df 100644
--- a/src/proto_alpha/lib_protocol/src/constants_repr.ml
+++ b/src/proto_alpha/lib_protocol/src/constants_repr.ml
@@ -99,7 +99,7 @@ let default = {
     | Ok c -> c
     | Error _ -> assert false
   end ;
-  origination_burn = Tez_repr.one ;
+  origination_burn = Tez_repr.of_mutez_exn 257L ;
   block_security_deposit = Tez_repr.(mul_exn one 512) ;
   endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
   block_reward = Tez_repr.(mul_exn one 16) ;
diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.ml b/src/proto_alpha/lib_protocol/src/contract_storage.ml
index e01220a6f..a8dc2f625 100644
--- a/src/proto_alpha/lib_protocol/src/contract_storage.ml
+++ b/src/proto_alpha/lib_protocol/src/contract_storage.ml
@@ -225,7 +225,7 @@ let create_base c contract
        let total_size = Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size in
        assert Compare.Z.(total_size >= Z.zero) ;
        Storage.Contract.Used_storage_space.init c contract total_size >>=? fun c ->
-       Storage.Contract.Paid_storage_space_fees.init c contract Tez_repr.zero
+       Storage.Contract.Paid_storage_space.init c contract Z.zero
    | None ->
        return c) >>=? fun c ->
   return c
@@ -252,7 +252,7 @@ let delete c contract =
       Storage.Contract.Counter.delete c contract >>=? fun c ->
       Storage.Contract.Code.remove c contract >>=? fun (c, _) ->
       Storage.Contract.Storage.remove c contract >>=? fun (c, _) ->
-      Storage.Contract.Paid_storage_space_fees.remove c contract >>= fun c ->
+      Storage.Contract.Paid_storage_space.remove c contract >>= fun c ->
       Storage.Contract.Used_storage_space.remove c contract >>= fun c ->
       return c
 
@@ -461,18 +461,19 @@ let used_storage_space c contract =
   | None -> return Z.zero
   | Some fees -> return fees
 
-let paid_storage_space_fees c contract =
-  Storage.Contract.Paid_storage_space_fees.get_option c contract >>=? function
-  | None -> return Tez_repr.zero
-  | Some paid_fees -> return paid_fees
+let paid_storage_space c contract =
+  Storage.Contract.Paid_storage_space.get_option c contract >>=? function
+  | None -> return Z.zero
+  | Some paid_space -> return paid_space
 
-let pay_for_storage_space c contract fees =
-  if Tez_repr.equal fees Tez_repr.zero then
-    return c
+let record_paid_storage_space c contract paid_storage =
+  Storage.Contract.Paid_storage_space.get c contract >>=? fun already_paid_fees ->
+  if Compare.Z.(already_paid_fees < paid_storage) then
+    return (Z.zero, c)
   else
-    Storage.Contract.Paid_storage_space_fees.get c contract >>=? fun paid_fees ->
-    Lwt.return (Tez_repr.(paid_fees +? fees)) >>=? fun paid_fees ->
-    Storage.Contract.Paid_storage_space_fees.set c contract paid_fees
+    let to_pay = Z.sub paid_storage already_paid_fees in
+    Storage.Contract.Paid_storage_space.set c contract paid_storage >>=? fun c ->
+    return (to_pay, c)
 
 module Big_map = struct
   let mem ctxt contract key =
diff --git a/src/proto_alpha/lib_protocol/src/contract_storage.mli b/src/proto_alpha/lib_protocol/src/contract_storage.mli
index 7bece6eda..b0a3c01e9 100644
--- a/src/proto_alpha/lib_protocol/src/contract_storage.mli
+++ b/src/proto_alpha/lib_protocol/src/contract_storage.mli
@@ -103,8 +103,8 @@ val init:
   Raw_context.t -> Raw_context.t tzresult Lwt.t
 
 val used_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
-val paid_storage_space_fees: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
-val pay_for_storage_space: Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t
+val paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
+val record_paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t
 
 module Big_map : sig
   val mem :
diff --git a/src/proto_alpha/lib_protocol/src/fees.ml b/src/proto_alpha/lib_protocol/src/fees.ml
index e1b4cfaee..85933d491 100644
--- a/src/proto_alpha/lib_protocol/src/fees.ml
+++ b/src/proto_alpha/lib_protocol/src/fees.ml
@@ -7,8 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Alpha_context
-
 type error += Cannot_pay_storage_fee
 
 let () =
@@ -23,29 +21,30 @@ let () =
     (fun () -> Cannot_pay_storage_fee)
 
 
-let origination_burn c ~payer contract =
-  let origination_burn = Constants.origination_burn c in
-  Contract.spend_from_script c payer origination_burn >>=? fun c ->
-  Contract.used_storage_space c contract >>=? fun size ->
-  let cost_per_byte = Constants.cost_per_byte c in
-  Lwt.return (Tez.(cost_per_byte *? (Z.to_int64 size))) >>=? fun fees ->
-  trace Cannot_pay_storage_fee
-    (Contract.spend_from_script c payer fees >>=? fun c ->
-     Contract.pay_for_storage_space c contract fees) >>=? fun c ->
-  return (c, size, fees)
+let origination_burn c ~payer =
+  let origination_burn = Constants_storage.origination_burn c in
+  Contract_storage.spend_from_script c payer origination_burn >>=? fun c ->
+  return (c, origination_burn)
 
-let update_script_storage c ~payer contract =
-  Contract.paid_storage_space_fees c contract >>=? fun paid_fees ->
-  Contract.used_storage_space c contract >>=? fun size ->
-  let cost_per_byte = Constants.cost_per_byte c in
-  Lwt.return (Tez.(cost_per_byte *? (Z.to_int64 size))) >>=? fun fees ->
-  match Tez.(fees -? paid_fees) with
-  | Error _ ->
-      (* Previously paid fees are greater than required fees. *)
-      return (c, size, Tez.zero)
-  | Ok to_be_paid ->
-      (* Burning the fees... *)
-      trace Cannot_pay_storage_fee
-        (Contract.spend_from_script c payer to_be_paid >>=? fun c ->
-         Contract.pay_for_storage_space c contract to_be_paid) >>=? fun c ->
-      return (c, size, to_be_paid)
+let record_paid_storage_space c contract =
+  Contract_storage.used_storage_space c contract >>=? fun size ->
+  Contract_storage.record_paid_storage_space c contract size >>=? fun (to_be_paid, c) ->
+  Lwt.return (Raw_context.update_storage_space_to_pay c to_be_paid) >>=? fun c ->
+  let cost_per_byte = Constants_storage.cost_per_byte c in
+  Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 to_be_paid))) >>=? fun to_burn ->
+  return (c, size, to_burn)
+
+let burn_fees_for_storage c ~payer =
+  let c, storage_space_to_pay = Raw_context.clear_storage_space_to_pay c in
+  let cost_per_byte = Constants_storage.cost_per_byte c in
+  Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 storage_space_to_pay))) >>=? fun to_burn ->
+  (* Burning the fees... *)
+  trace Cannot_pay_storage_fee
+    (Contract_storage.spend_from_script c payer to_burn) >>=? fun c ->
+  return c
+
+let with_fees_for_storage c ~payer f =
+  Lwt.return (Raw_context.init_storage_space_to_pay c) >>=? fun c ->
+  f c >>=? fun (c, ret) ->
+  burn_fees_for_storage c ~payer >>=? fun c ->
+  return (c, ret)
diff --git a/src/proto_alpha/lib_protocol/src/fees.mli b/src/proto_alpha/lib_protocol/src/fees.mli
index 3ac308718..ea687d394 100644
--- a/src/proto_alpha/lib_protocol/src/fees.mli
+++ b/src/proto_alpha/lib_protocol/src/fees.mli
@@ -7,14 +7,17 @@
 (*                                                                        *)
 (**************************************************************************)
 
-open Alpha_context
-
 type error += Cannot_pay_storage_fee
 
 val origination_burn:
-  Alpha_context.t -> payer:Contract.t ->
-  Contract.t -> (Alpha_context.t * Z.t * Tez.t) tzresult Lwt.t
+  Raw_context.t -> payer:Contract_repr.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t
 
-val update_script_storage:
-  Alpha_context.t -> payer:Contract.t ->
-  Contract.t -> (Alpha_context.t * Z.t * Tez.t) tzresult Lwt.t
+(** The returned Tez quantity is for logging purpose only *)
+val record_paid_storage_space:
+  Raw_context.t -> Contract_repr.t ->
+  (Raw_context.t * Z.t * Tez_repr.t) tzresult Lwt.t
+
+val with_fees_for_storage:
+  Raw_context.t -> payer:Contract_repr.t ->
+  (Raw_context.t -> (Raw_context.t * 'a) tzresult Lwt.t) ->
+  (Raw_context.t * 'a) tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/src/raw_context.ml b/src/proto_alpha/lib_protocol/src/raw_context.ml
index 0e2f6642e..bb510cbe3 100644
--- a/src/proto_alpha/lib_protocol/src/raw_context.ml
+++ b/src/proto_alpha/lib_protocol/src/raw_context.ml
@@ -23,6 +23,7 @@ type t = {
   rewards: Tez_repr.t ;
   block_gas: Z.t ;
   operation_gas: Gas_limit_repr.t ;
+  storage_space_to_pay: Z.t option ;
   block_storage: Z.t ;
   operation_storage: Storage_limit_repr.t ;
   origination_nonce: Contract_repr.origination_nonce option ;
@@ -181,6 +182,27 @@ let gas_consumed ~since ~until =
 
 type error += Storage_limit_too_high (* `Permanent *)
 
+let init_storage_space_to_pay ctxt =
+  match ctxt.storage_space_to_pay with
+  | Some _ ->
+      assert false
+  | None ->
+      ok { ctxt with storage_space_to_pay = Some Z.zero }
+
+let update_storage_space_to_pay ctxt n =
+  match ctxt.storage_space_to_pay with
+  | None ->
+      assert false
+  | Some storage_space_to_pay ->
+      ok { ctxt with storage_space_to_pay = Some (Z.add n storage_space_to_pay) }
+
+let clear_storage_space_to_pay ctxt =
+  match ctxt.storage_space_to_pay with
+  | None ->
+      assert false
+  | Some storage_space_to_pay ->
+      { ctxt with storage_space_to_pay = None }, storage_space_to_pay
+
 let () =
   let open Data_encoding in
   register_error_kind
@@ -427,6 +449,7 @@ let prepare ~level ~timestamp ~fitness ctxt =
     rewards = Tez_repr.zero ;
     deposits = Signature.Public_key_hash.Map.empty ;
     operation_gas = Unaccounted ;
+    storage_space_to_pay = None ;
     block_gas = constants.Constants_repr.hard_gas_limit_per_block ;
     operation_storage = Unaccounted ;
     block_storage = constants.Constants_repr.hard_storage_limit_per_block ;
@@ -475,6 +498,7 @@ let register_resolvers enc resolve =
       timestamp = Time.of_seconds 0L ;
       fitness = 0L ;
       allowed_endorsements = Signature.Public_key_hash.Map.empty ;
+      storage_space_to_pay = None ;
       fees = Tez_repr.zero ;
       rewards = Tez_repr.zero ;
       deposits = Signature.Public_key_hash.Map.empty ;
diff --git a/src/proto_alpha/lib_protocol/src/raw_context.mli b/src/proto_alpha/lib_protocol/src/raw_context.mli
index 7d3b8455a..793afe174 100644
--- a/src/proto_alpha/lib_protocol/src/raw_context.mli
+++ b/src/proto_alpha/lib_protocol/src/raw_context.mli
@@ -88,6 +88,10 @@ val block_gas_level: t -> Z.t
 
 type error += Storage_limit_too_high (* `Permanent *)
 
+val init_storage_space_to_pay: t -> t tzresult
+val update_storage_space_to_pay: t -> Z.t -> t tzresult
+val clear_storage_space_to_pay: t -> t * Z.t
+
 val set_storage_limit: t -> Z.t -> t tzresult
 val set_storage_unlimited: t -> t
 
diff --git a/src/proto_alpha/lib_protocol/src/storage.ml b/src/proto_alpha/lib_protocol/src/storage.ml
index 5a457d223..d071d014e 100644
--- a/src/proto_alpha/lib_protocol/src/storage.ml
+++ b/src/proto_alpha/lib_protocol/src/storage.ml
@@ -172,10 +172,10 @@ module Contract = struct
         let encoding = Script_repr.expr_encoding
       end)
 
-  module Paid_storage_space_fees =
+  module Paid_storage_space =
     Indexed_context.Make_map
       (struct let name = ["paid_bytes"] end)
-      (Tez_repr)
+      (Z)
 
   module Used_storage_space =
     Indexed_context.Make_map
diff --git a/src/proto_alpha/lib_protocol/src/storage.mli b/src/proto_alpha/lib_protocol/src/storage.mli
index ee435f661..be775df87 100644
--- a/src/proto_alpha/lib_protocol/src/storage.mli
+++ b/src/proto_alpha/lib_protocol/src/storage.mli
@@ -179,10 +179,10 @@ module Contract : sig
      and type value = Z.t
      and type t := Raw_context.t
 
-  (** Total fees burnt for storage space. *)
-  module Paid_storage_space_fees : Indexed_data_storage
+  (** Maximal space available without needing to burn new fees. *)
+  module Paid_storage_space : Indexed_data_storage
     with type key = Contract_repr.t
-     and type value = Tez_repr.t
+     and type value = Z.t
      and type t := Raw_context.t
 
   type bigmap_key = Raw_context.t * Contract_repr.t