diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index b3e21f2137714e61272900ae55766c8799461666..7fc26862eea3635ddb88e194b5f802b3a64bb6d6 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2138,7 +2138,12 @@ module Delegate : sig
   val already_slashed_for_double_baking :
     context -> public_key_hash -> Level.t -> bool tzresult Lwt.t
 
-  type punishing_amounts = {reward : Tez.t; amount_to_burn : Tez.t}
+  type reward_and_burn = {reward : Tez.t; amount_to_burn : Tez.t}
+
+  type punishing_amounts = {
+    staked : reward_and_burn;
+    unstaked : (Cycle.t * reward_and_burn) list;
+  }
 
   val punish_double_endorsing :
     context ->
diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index e73bc5ddf7bbbe094b19557dcdca77d588d38537..6fb2d793b29404ebe7f58aaec843b2ff285562f4 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1942,25 +1942,9 @@ let apply_manager_operations ctxt ~payload_producer chain_id ~mempool_mode
   return (ctxt, contents_result_list)
 
 let punish_delegate ctxt delegate level mistake mk_result ~payload_producer =
-  let punish =
-    match mistake with
-    | `Double_baking -> Delegate.punish_double_baking
-    | `Double_endorsing -> Delegate.punish_double_endorsing
-  in
-  punish ctxt delegate level >>=? fun (ctxt, {reward; amount_to_burn}) ->
-  Token.transfer
-    ctxt
-    (`Frozen_deposits delegate)
-    `Double_signing_punishments
-    amount_to_burn
-  >>=? fun (ctxt, punish_balance_updates) ->
-  Token.transfer
-    ctxt
-    (`Frozen_deposits delegate)
-    (`Contract (Contract.Implicit payload_producer.Consensus_key.delegate))
-    reward
-  >|=? fun (ctxt, reward_balance_updates) ->
-  let balance_updates = reward_balance_updates @ punish_balance_updates in
+  let rewarded = Contract.Implicit payload_producer.Consensus_key.delegate in
+  Staking.punish_delegate ctxt delegate level mistake ~rewarded
+  >|=? fun (ctxt, balance_updates) ->
   (ctxt, Single_result (mk_result balance_updates))
 
 let punish_double_endorsement_or_preendorsement (type kind) ctxt
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
index e0bce8b3a522e8768caefd3bc89d22b86d188cbd..daabd57deb90e9e87b584ef1a92ac5217bf84235 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.ml
@@ -37,7 +37,12 @@ let already_slashed_for_double_baking ctxt delegate (level : Level_repr.t) =
   | None -> return_false
   | Some slashed -> return slashed.for_double_baking
 
-type punishing_amounts = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
+type reward_and_burn = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
+
+type punishing_amounts = {
+  staked : reward_and_burn;
+  unstaked : (Cycle_repr.t * reward_and_burn) list;
+}
 
 (** [punish_double_signing ~get ~set ~get_percentage ctxt delegate level] record
     in the context that the given [delegate] has now been slashed for the
@@ -61,32 +66,56 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
   assert (Compare.Bool.(get slashed = false)) ;
   let updated_slashed = set slashed in
   let delegate_contract = Contract_repr.Implicit delegate in
-  let* frozen_deposits = Frozen_deposits_storage.get ctxt delegate_contract in
   let slashing_percentage = get_percentage ctxt in
-  let punish_value =
-    Tez_repr.(
-      div_exn (mul_exn frozen_deposits.initial_amount slashing_percentage) 100)
-  in
-  let punishing_amount =
-    Tez_repr.(min frozen_deposits.current_amount punish_value)
-  in
+  let preserved_cycles = Constants_storage.preserved_cycles ctxt in
   let staking_over_baking_limit =
     Constants_storage.adaptive_inflation_staking_over_baking_limit ctxt
   in
   let staking_over_baking_limit_plus_two =
     Int64.add (Int64.of_int staking_over_baking_limit) 2L
   in
-  let*? reward =
-    Tez_repr.(punishing_amount /? staking_over_baking_limit_plus_two)
-  in
-  let*? amount_to_burn = Tez_repr.(punishing_amount -? reward) in
-  let should_forbid =
-    Tez_repr.(punishing_amount = frozen_deposits.current_amount)
+  let compute_reward_and_burn (frozen_deposits : Deposits_repr.t) =
+    let open Result_syntax in
+    let punish_value =
+      Tez_repr.(
+        div_exn (mul_exn frozen_deposits.initial_amount slashing_percentage) 100)
+    in
+    let should_forbid, punishing_amount =
+      if Tez_repr.(punish_value >= frozen_deposits.current_amount) then
+        (true, frozen_deposits.current_amount)
+      else (false, punish_value)
+    in
+    let* reward =
+      Tez_repr.(punishing_amount /? staking_over_baking_limit_plus_two)
+    in
+    let+ amount_to_burn = Tez_repr.(punishing_amount -? reward) in
+    (should_forbid, {reward; amount_to_burn})
   in
+  let* frozen_deposits = Frozen_deposits_storage.get ctxt delegate_contract in
+  let*? should_forbid, staked = compute_reward_and_burn frozen_deposits in
   let*! ctxt =
     if should_forbid then Delegate_storage.forbid_delegate ctxt delegate
     else Lwt.return ctxt
   in
+  let* unstaked =
+    let oldest_slashable_cycle =
+      Cycle_repr.sub level.cycle preserved_cycles
+      |> Option.value ~default:Cycle_repr.root
+    in
+    let slashable_cycles =
+      Cycle_repr.(oldest_slashable_cycle ---> level.cycle)
+    in
+    List.rev_map_es
+      (fun cycle ->
+        let* frozen_deposits =
+          Unstaked_frozen_deposits_storage.get ctxt delegate cycle
+        in
+        let*? _should_forbid, reward_and_burn =
+          compute_reward_and_burn frozen_deposits
+        in
+        return (cycle, reward_and_burn))
+      slashable_cycles
+  in
   let*! ctxt =
     Storage.Slashed_deposits.add
       (ctxt, level.cycle)
@@ -106,7 +135,7 @@ let punish_double_signing ~get ~set ~get_percentage ctxt delegate
   let*! ctxt =
     Storage.Contract.Slashed_deposits.add ctxt delegate_contract slash_history
   in
-  return (ctxt, {reward; amount_to_burn})
+  return (ctxt, {staked; unstaked})
 
 let punish_double_endorsing =
   let get Storage.{for_double_endorsing; _} = for_double_endorsing in
diff --git a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
index 5275afdfa55ed81e26be9c8ad78f069806bafc56..9f2166a871dc42665ff97d53742b1b0120143557 100644
--- a/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/delegate_slashed_deposits_storage.mli
@@ -46,9 +46,16 @@ val already_slashed_for_double_endorsing :
   Level_repr.t ->
   bool tzresult Lwt.t
 
+(** The [reward_and_burn] type embeds amounts involved when slashing a
+    delegate for double endorsing or double baking. *)
+type reward_and_burn = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
+
 (** The [punishing_amounts] type embeds amounts involved when slashing a
     delegate for double endorsing or double baking. *)
-type punishing_amounts = {reward : Tez_repr.t; amount_to_burn : Tez_repr.t}
+type punishing_amounts = {
+  staked : reward_and_burn;
+  unstaked : (Cycle_repr.t * reward_and_burn) list;
+}
 
 (** Record in the context that the given delegate has now been slashed
     for double endorsing for the given level and return the amounts to
diff --git a/src/proto_alpha/lib_protocol/staking.ml b/src/proto_alpha/lib_protocol/staking.ml
index b87e9afe5609ec5d42e8428ecc5a1cf8dfe49637..9ed8e30864e905056b33a08c0b8072115a78c375 100644
--- a/src/proto_alpha/lib_protocol/staking.ml
+++ b/src/proto_alpha/lib_protocol/staking.ml
@@ -45,3 +45,32 @@ let finalize_unstake ctxt pkh =
       (ctxt, new_balance_updates @ balance_updates))
     (ctxt, [])
     finalizable
+
+let punish_delegate ctxt delegate level mistake ~rewarded =
+  let open Lwt_result_syntax in
+  let punish =
+    match mistake with
+    | `Double_baking -> Delegate.punish_double_baking
+    | `Double_endorsing -> Delegate.punish_double_endorsing
+  in
+  let* ctxt, {staked; unstaked} = punish ctxt delegate level in
+  let init_to_burn_to_reward =
+    let Delegate.{amount_to_burn; reward} = staked in
+    let giver = `Frozen_deposits delegate in
+    ([(giver, amount_to_burn)], [(giver, reward)])
+  in
+  let to_burn, to_reward =
+    List.fold_left
+      (fun (to_burn, to_reward) (cycle, Delegate.{amount_to_burn; reward}) ->
+        let giver = `Unstaked_frozen_deposits (delegate, cycle) in
+        ((giver, amount_to_burn) :: to_burn, (giver, reward) :: to_reward))
+      init_to_burn_to_reward
+      unstaked
+  in
+  let* ctxt, punish_balance_updates =
+    Token.transfer_n ctxt to_burn `Double_signing_punishments
+  in
+  let+ ctxt, reward_balance_updates =
+    Token.transfer_n ctxt to_reward (`Contract rewarded)
+  in
+  (ctxt, reward_balance_updates @ punish_balance_updates)
diff --git a/src/proto_alpha/lib_protocol/staking.mli b/src/proto_alpha/lib_protocol/staking.mli
index 4be8b752f8e214fa1451aeada971b660c005880b..bf9b986201c0103794dd5226b5122d13405edb9b 100644
--- a/src/proto_alpha/lib_protocol/staking.mli
+++ b/src/proto_alpha/lib_protocol/staking.mli
@@ -38,3 +38,13 @@ val finalize_unstake :
   context ->
   public_key_hash ->
   (context * Receipt.balance_updates) tzresult Lwt.t
+
+(** [punish_delegate ctxt delegate level mistake ~rewarded] slashes [delegate]
+    for a [mistake] at [level] and rewards [rewarded]. *)
+val punish_delegate :
+  context ->
+  public_key_hash ->
+  Level.t ->
+  [`Double_baking | `Double_endorsing] ->
+  rewarded:Contract.t ->
+  (context * Receipt.balance_updates) tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.ml b/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.ml
index 5248e8d701391ab6a6f5570a1f9f9defdcd4a5de..388fd6e443d8a4a97ad62832aa4f86dff5d96641 100644
--- a/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.ml
+++ b/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.ml
@@ -58,11 +58,14 @@ let normalized_cycle ctxt ~cycle =
   | None -> cycle
   | Some unslashable_cycle -> Cycle_repr.max cycle unslashable_cycle
 
-let balance ctxt delegate cycle =
-  let open Lwt_result_syntax in
+let get ctxt delegate cycle =
   let contract = Contract_repr.Implicit delegate in
   let normalized_cycle = normalized_cycle ctxt ~cycle in
-  let+ frozen_deposits = Internal.get ctxt contract ~normalized_cycle in
+  Internal.get ctxt contract ~normalized_cycle
+
+let balance ctxt delegate cycle =
+  let open Lwt_result_syntax in
+  let+ frozen_deposits = get ctxt delegate cycle in
   frozen_deposits.current_amount
 
 let credit_only_call_from_token ctxt delegate cycle amount =
diff --git a/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.mli b/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.mli
index 62ae2c3677c9e3f783ffc18365bc2b0a96df7cdf..888f046686bf8541ddf874c1918edebe6c4a2d8f 100644
--- a/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.mli
+++ b/src/proto_alpha/lib_protocol/unstaked_frozen_deposits_storage.mli
@@ -38,6 +38,14 @@ val balance :
   Cycle_repr.t ->
   Tez_repr.t tzresult Lwt.t
 
+(** [get] acts like [balance] but returns both the initial amount and the
+    current amount. *)
+val get :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Cycle_repr.t ->
+  Deposits_repr.t tzresult Lwt.t
+
 (** [credit_only_call_from_token ctxt delegate cycle amount] credits the
     unstaked frozen deposits for [delegate] at [cycle] by [amount].
     If [cycle] is an unslashable cycle, the credited cycle is the last