diff --git a/docs/protocols/alpha.rst b/docs/protocols/alpha.rst
index 92b1918cc20ebdb6925f257da6ab834c974d3ecc..bdda52f1de293ebe2b596382d0a4cd5303c0a072 100644
--- a/docs/protocols/alpha.rst
+++ b/docs/protocols/alpha.rst
@@ -85,6 +85,14 @@ Minor Changes
   now be immediately propagated by the mempool, allowing for a much
   faster PQC. (MR :gl:`!7815`)
 
+- The mempool now accepts and propagates consensus operations with a
+  non-minimal slot (for performance reasons: testing the minimality of
+  the slot there is too costly). Such operations are still invalid in
+  blocks. To avoid mempools getting spammed with operations with
+  various slots, double (pre)endorsement denunciations can now punish
+  multiple operations from the same delegate with distinct slots.
+  (MR :gl:`!7927`)
+
 Internal
 --------
 
diff --git a/src/proto_alpha/lib_plugin/RPC.ml b/src/proto_alpha/lib_plugin/RPC.ml
index 41979ce3f2eefa9c0f47d0379ed54f202c92904a..0ca0a7bb72d0d4464adc0a713f6010b9f10b8786 100644
--- a/src/proto_alpha/lib_plugin/RPC.ml
+++ b/src/proto_alpha/lib_plugin/RPC.ml
@@ -963,10 +963,8 @@ module Scripts = struct
       oph
       packed_operation
     >>=? fun _validate_operation_state ->
-    Raw_level.of_int32 block_header.level >>?= fun predecessor_level ->
     let application_mode =
-      Apply.Partial_construction
-        {predecessor_level; predecessor_fitness = block_header.fitness}
+      Apply.Partial_construction {predecessor_fitness = block_header.fitness}
     in
     let application_state =
       Apply.
diff --git a/src/proto_alpha/lib_protocol/alpha_context.ml b/src/proto_alpha/lib_protocol/alpha_context.ml
index 18c5c2b5758056c141a349d86c9418a3f1a7352f..3e7e28721f3f5274d8263179fc243aa9343f6f01 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.ml
+++ b/src/proto_alpha/lib_protocol/alpha_context.ml
@@ -558,6 +558,8 @@ module Stake_distribution = struct
   let baking_rights_owner = Delegate_sampler.baking_rights_owner
 
   let slot_owner = Delegate_sampler.slot_owner
+
+  let load_sampler_for_cycle = Delegate_sampler.load_sampler_for_cycle
 end
 
 module Nonce = Nonce_storage
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index d36f8f6312cd265dc27de58df5c5237bd9ecdc9d..9846e896f6abab848377002c7c5b48a3c9e70c08 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -1227,6 +1227,9 @@ module Fitness : sig
 
   val predecessor_round_from_raw : raw -> Round.t tzresult
 
+  (** See {!Fitness_repr.locked_round_from_raw}. *)
+  val locked_round_from_raw : raw -> Round.t option tzresult
+
   val level : t -> Raw_level.t
 
   val round : t -> Round.t
@@ -5048,6 +5051,9 @@ module Stake_distribution : sig
 
   val slot_owner :
     context -> Level.t -> Slot.t -> (context * Consensus_key.pk) tzresult Lwt.t
+
+  (** See {!Delegate_sampler.load_sampler_for_cycle}. *)
+  val load_sampler_for_cycle : context -> Cycle.t -> context tzresult Lwt.t
 end
 
 (** This module re-exports definitions from {!Commitment_repr} and,
diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 11d565336f9747258208b96e8d2c6ad42983d491..c84a2d53844a6c36a8d5b982b0cbb8c17c2faa68 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1801,10 +1801,7 @@ type mode =
       predecessor_level : Level.t;
       predecessor_round : Round.t;
     }
-  | Partial_construction of {
-      predecessor_level : Raw_level.t;
-      predecessor_fitness : Fitness.raw;
-    }
+  | Partial_construction of {predecessor_fitness : Fitness.raw}
 
 type application_state = {
   ctxt : t;
@@ -1832,11 +1829,14 @@ let record_operation (type kind) ctxt hash (operation : kind operation) :
       record_non_consensus_operation_hash ctxt hash
 
 let find_in_slot_map consensus_content slot_map =
-  match Slot.Map.find consensus_content.slot slot_map with
-  | Some (consensus_key, power) -> return (consensus_key, power)
-  | None ->
-      (* This should not happen: operation validation should have failed. *)
-      tzfail Faulty_validation_wrong_slot
+  match slot_map with
+  | None -> error (Consensus.Slot_map_not_found {loc = __LOC__})
+  | Some slot_map -> (
+      match Slot.Map.find consensus_content.slot slot_map with
+      | None ->
+          (* This should not happen: operation validation should have failed. *)
+          error Faulty_validation_wrong_slot
+      | Some (consensus_key, power) -> ok (consensus_key, power))
 
 let record_preendorsement ctxt (mode : mode) (content : consensus_content) :
     (context * Kind.preendorsement contents_result_list) tzresult Lwt.t =
@@ -1849,7 +1849,7 @@ let record_preendorsement ctxt (mode : mode) (content : consensus_content) :
         | Some _ -> ctxt)
     | Application _ | Partial_construction _ -> ctxt
   in
-  let mk_preendorsement_result {Consensus_key.delegate; consensus_pkh; _}
+  let mk_preendorsement_result ({delegate; consensus_pkh; _} : Consensus_key.pk)
       preendorsement_power =
     Single_result
       (Preendorsement_result
@@ -1862,7 +1862,7 @@ let record_preendorsement ctxt (mode : mode) (content : consensus_content) :
   in
   match mode with
   | Application _ | Full_construction _ ->
-      let* consensus_key, power =
+      let*? consensus_key, power =
         find_in_slot_map content (Consensus.allowed_preendorsements ctxt)
       in
       let*? ctxt =
@@ -1872,9 +1872,8 @@ let record_preendorsement ctxt (mode : mode) (content : consensus_content) :
           ~power
           content.round
       in
-      return
-        (ctxt, mk_preendorsement_result (Consensus_key.pkh consensus_key) power)
-  | Partial_construction {predecessor_level; _} ->
+      return (ctxt, mk_preendorsement_result consensus_key power)
+  | Partial_construction _ ->
       (* In mempool mode, preendorsements are allowed for various levels
          and rounds. We do not record preendorsements because we could get
          false-positive conflicts for preendorsements with the same slot
@@ -1882,31 +1881,16 @@ let record_preendorsement ctxt (mode : mode) (content : consensus_content) :
          for the mempool head's level and round (the most usual
          preendorsements), but we don't need to, because there is no block
          to finalize anyway in this mode. *)
-      let* ctxt, consensus_key, power =
-        if Raw_level.(content.level = predecessor_level) then
-          (* We can use the pre-computed slot map, which contains the
-             consensus rights at the predecessor level. *)
-          let* consensus_key, power =
-            find_in_slot_map content (Consensus.allowed_preendorsements ctxt)
-          in
-          return (ctxt, consensus_key, power)
-        else
-          (* We retrieve the key directly, and return a fake voting
-             power of 0 because it doesn't matter for a past or future
-             preendorsement.*)
-          let level = Level.from_raw ctxt content.level in
-          let* ctxt, consensus_key =
-            Stake_distribution.slot_owner ctxt level content.slot
-          in
-          return (ctxt, consensus_key, 0)
+      let* ctxt, consensus_key =
+        let level = Level.from_raw ctxt content.level in
+        Stake_distribution.slot_owner ctxt level content.slot
       in
-      return
-        (ctxt, mk_preendorsement_result (Consensus_key.pkh consensus_key) power)
+      return (ctxt, mk_preendorsement_result consensus_key 0 (* Fake power. *))
 
 let record_endorsement ctxt (mode : mode) (content : consensus_content) :
     (context * Kind.endorsement contents_result_list) tzresult Lwt.t =
   let open Lwt_result_syntax in
-  let mk_endorsement_result {Consensus_key.delegate; consensus_pkh}
+  let mk_endorsement_result ({delegate; consensus_pkh; _} : Consensus_key.pk)
       endorsement_power =
     Single_result
       (Endorsement_result
@@ -1919,15 +1903,14 @@ let record_endorsement ctxt (mode : mode) (content : consensus_content) :
   in
   match mode with
   | Application _ | Full_construction _ ->
-      let* consensus_key, power =
+      let*? consensus_key, power =
         find_in_slot_map content (Consensus.allowed_endorsements ctxt)
       in
       let*? ctxt =
         Consensus.record_endorsement ctxt ~initial_slot:content.slot ~power
       in
-      return
-        (ctxt, mk_endorsement_result (Consensus_key.pkh consensus_key) power)
-  | Partial_construction {predecessor_level; _} ->
+      return (ctxt, mk_endorsement_result consensus_key power)
+  | Partial_construction _ ->
       (* In mempool mode, endorsements are allowed for various levels
          and rounds. We do not record endorsements because we could get
          false-positive conflicts for endorsements with the same slot
@@ -1935,26 +1918,11 @@ let record_endorsement ctxt (mode : mode) (content : consensus_content) :
          for the predecessor's level and round (the most usual
          endorsements), but we don't need to, because there is no block
          to finalize anyway in this mode. *)
-      let* ctxt, consensus_key, power =
-        if Raw_level.(content.level = predecessor_level) then
-          (* We can use the pre-computed slot map, which contains the
-             consensus rights at the predecessor level. *)
-          let* consensus_key, power =
-            find_in_slot_map content (Consensus.allowed_endorsements ctxt)
-          in
-          return (ctxt, consensus_key, power)
-        else
-          (* We retrieve the key directly, and return a fake voting
-             power of 0 because it doesn't matter for a past or future
-             endorsement.*)
-          let level = Level.from_raw ctxt content.level in
-          let* ctxt, consensus_key =
-            Stake_distribution.slot_owner ctxt level content.slot
-          in
-          return (ctxt, consensus_key, 0)
+      let* ctxt, consensus_key =
+        let level = Level.from_raw ctxt content.level in
+        Stake_distribution.slot_owner ctxt level content.slot
       in
-      return
-        (ctxt, mk_endorsement_result (Consensus_key.pkh consensus_key) power)
+      return (ctxt, mk_endorsement_result consensus_key 0 (* Fake power. *))
 
 let apply_manager_contents_list ctxt ~payload_producer chain_id
     fees_updated_contents_list =
@@ -2359,7 +2327,12 @@ let are_endorsements_required ctxt ~level =
   Compare.Int32.(level_position_in_protocol > 1l)
 
 let record_endorsing_participation ctxt =
-  let validators = Consensus.allowed_endorsements ctxt in
+  let open Lwt_result_syntax in
+  let*? validators =
+    match Consensus.allowed_endorsements ctxt with
+    | Some x -> ok x
+    | None -> error (Consensus.Slot_map_not_found {loc = __LOC__})
+  in
   Slot.Map.fold_es
     (fun initial_slot ((consensus_pk : Consensus_key.pk), power) ctxt ->
       let participation =
@@ -2491,7 +2464,7 @@ let begin_full_construction ctxt chain_id ~migration_balance_updates
     }
 
 let begin_partial_construction ctxt chain_id ~migration_balance_updates
-    ~migration_operation_results ~predecessor_level ~predecessor_hash
+    ~migration_operation_results ~predecessor_hash
     ~(predecessor_fitness : Fitness.raw) : application_state tzresult Lwt.t =
   let open Lwt_result_syntax in
   let toggle_vote = Liquidity_baking.LB_pass in
@@ -2507,7 +2480,7 @@ let begin_partial_construction ctxt chain_id ~migration_balance_updates
     let predecessor = predecessor_hash in
     Sc_rollup.Inbox.add_info_per_level ~predecessor ctxt
   in
-  let mode = Partial_construction {predecessor_level; predecessor_fitness} in
+  let mode = Partial_construction {predecessor_fitness} in
   return
     {
       mode;
diff --git a/src/proto_alpha/lib_protocol/apply.mli b/src/proto_alpha/lib_protocol/apply.mli
index 36c3d27662262bef654c03b3acb4df0986ff736f..08dc24f8c2123370a1f9a336989c0b07b7fe587b 100644
--- a/src/proto_alpha/lib_protocol/apply.mli
+++ b/src/proto_alpha/lib_protocol/apply.mli
@@ -61,10 +61,8 @@ type mode =
       predecessor_level : Level.t;
       predecessor_round : Round.t;
     }
-  | Partial_construction of {
-      predecessor_level : Raw_level.t;
-      predecessor_fitness : Fitness.raw;
-    }  (** This mode is mainly intended to be used by a mempool. *)
+  | Partial_construction of {predecessor_fitness : Fitness.raw}
+      (** This mode is mainly intended to be used by a mempool. *)
 
 type application_state = {
   ctxt : context;
@@ -111,7 +109,6 @@ val begin_partial_construction :
   Chain_id.t ->
   migration_balance_updates:Receipt.balance_updates ->
   migration_operation_results:Migration.origination_result list ->
-  predecessor_level:Raw_level.t ->
   predecessor_hash:Block_hash.t ->
   predecessor_fitness:Fitness.raw ->
   application_state tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.ml b/src/proto_alpha/lib_protocol/delegate_sampler.ml
index 0040d65f71e7e0b8646e45665f7a64280cb2772b..19e92d876cb8416f89c974a8714f51d497656e05 100644
--- a/src/proto_alpha/lib_protocol/delegate_sampler.ml
+++ b/src/proto_alpha/lib_protocol/delegate_sampler.ml
@@ -144,6 +144,13 @@ let baking_rights_owner c (level : Level_repr.t) ~round =
   Slot_repr.of_int (round mod consensus_committee_size) >>?= fun slot ->
   slot_owner c level slot >>=? fun (ctxt, pk) -> return (ctxt, slot, pk)
 
+let load_sampler_for_cycle ctxt cycle =
+  let open Lwt_result_syntax in
+  let* ctxt, (_ : Seed_repr.seed), (_ : Raw_context.consensus_pk Sampler.t) =
+    Random.sampler_for_cycle ctxt cycle
+  in
+  return ctxt
+
 let get_stakes_for_selected_index ctxt index =
   Stake_storage.fold_snapshot
     ctxt
diff --git a/src/proto_alpha/lib_protocol/delegate_sampler.mli b/src/proto_alpha/lib_protocol/delegate_sampler.mli
index b398a9ca946434c82f1086b9d4aa722cceac148f..864cea84b717b210ee152974a589fe2dbe4e0575 100644
--- a/src/proto_alpha/lib_protocol/delegate_sampler.mli
+++ b/src/proto_alpha/lib_protocol/delegate_sampler.mli
@@ -53,6 +53,15 @@ val baking_rights_owner :
   round:Round_repr.round ->
   (Raw_context.t * Slot_repr.t * Delegate_consensus_key.pk) tzresult Lwt.t
 
+(** [load_sampler_for_cycle ctxt cycle] caches the seeded stake
+    sampler for [cycle] in [ctxt]. If the sampler was already cached,
+    then [ctxt] is returned unchanged.
+
+    This function has the same effect on [ctxt] as {!slot_owner} and
+    {!baking_rights_owner}. *)
+val load_sampler_for_cycle :
+  Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t
+
 (** [compute_snapshot_index ctxt cycle max_snapshot_index] Returns the index of
     the selected snapshot for the [cycle] passed as argument, and for the max
     index of snapshots taken so far, [max_snapshot_index] (see
diff --git a/src/proto_alpha/lib_protocol/fitness_repr.ml b/src/proto_alpha/lib_protocol/fitness_repr.ml
index c802021f371b6073ea516825ff6c204dfc5f388f..f3440e0f55873c9a78c089d2df2996710d360bce 100644
--- a/src/proto_alpha/lib_protocol/fitness_repr.ml
+++ b/src/proto_alpha/lib_protocol/fitness_repr.ml
@@ -229,6 +229,18 @@ let predecessor_round_from_raw = function
   | [] (* genesis fitness *) -> ok Round_repr.zero
   | _ -> error Invalid_fitness
 
+let locked_round_from_raw = function
+  | [version; _level; locked_round; _neg_predecessor_round; _round]
+    when Compare.String.(
+           Bytes.to_string version = Constants_repr.fitness_version_number) ->
+      locked_round_of_bytes locked_round
+  | [version; _]
+    when Compare.String.(
+           Bytes.to_string version < Constants_repr.fitness_version_number) ->
+      ok None
+  | [] (* former genesis fitness *) -> ok None
+  | _ -> error Invalid_fitness
+
 let check_except_locked_round fitness ~level ~predecessor_round =
   let {
     level = expected_level;
diff --git a/src/proto_alpha/lib_protocol/fitness_repr.mli b/src/proto_alpha/lib_protocol/fitness_repr.mli
index 00aff9accfe91c2fbafcb52d115a716c85c1dd15..be487ed580dd53babffdf21420ec49c05362790d 100644
--- a/src/proto_alpha/lib_protocol/fitness_repr.mli
+++ b/src/proto_alpha/lib_protocol/fitness_repr.mli
@@ -70,6 +70,10 @@ val round_from_raw : Fitness.t -> Round_repr.t tzresult
    is from a previous protocol, the returned value will be Round.zero. *)
 val predecessor_round_from_raw : Fitness.t -> Round_repr.t tzresult
 
+(** Returns the locked round from a raw fitness. If the fitness is
+    from a previous version, the returned value will be None. *)
+val locked_round_from_raw : Fitness.t -> Round_repr.t option tzresult
+
 (** Validate only the part of the fitness for which information are
     available during begin_application *)
 val check_except_locked_round :
diff --git a/src/proto_alpha/lib_protocol/level_storage.ml b/src/proto_alpha/lib_protocol/level_storage.ml
index 331839bf787bb636d9f95a5dcbce87861469d5ca..2bf78176bc83becfa92cc186c5374733144fab53 100644
--- a/src/proto_alpha/lib_protocol/level_storage.ml
+++ b/src/proto_alpha/lib_protocol/level_storage.ml
@@ -38,7 +38,10 @@ let root c = Raw_context.cycle_eras c |> Level_repr.root_level
 let succ c (l : Level_repr.t) = from_raw c (Raw_level_repr.succ l.level)
 
 let pred c (l : Level_repr.t) =
-  match Raw_level_repr.pred l.Level_repr.level with
+  (* This returns [None] rather than level zero when [l] is level one
+     because {!from_raw} raises an exception when called on zero
+     (because [Level_repr.era_of_level] cannot find level zero's era). *)
+  match Raw_level_repr.pred_dontreturnzero l.Level_repr.level with
   | None -> None
   | Some l -> Some (from_raw c l)
 
diff --git a/src/proto_alpha/lib_protocol/level_storage.mli b/src/proto_alpha/lib_protocol/level_storage.mli
index 0049a81854518efaa61755b95edc5417ea6bcf2d..d5c2f82864ae0f4cea4e4f310a5ccbef53aa1ccd 100644
--- a/src/proto_alpha/lib_protocol/level_storage.mli
+++ b/src/proto_alpha/lib_protocol/level_storage.mli
@@ -35,6 +35,9 @@ val from_raw : Raw_context.t -> Raw_level_repr.t -> Level_repr.t
 val from_raw_with_offset :
   Raw_context.t -> offset:int32 -> Raw_level_repr.t -> Level_repr.t tzresult
 
+(** When the given level is two or above, return its predecessor. When
+    the given level is one or less, return [None] (because we cannot
+    build the [Level_repr.t] for level zero). *)
 val pred : Raw_context.t -> Level_repr.t -> Level_repr.t option
 
 val succ : Raw_context.t -> Level_repr.t -> Level_repr.t
diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml
index bbc00994427c29da811a6f7bf7b5c9741565ccf8..1dcb83bd372d4109af7ea3d366777a57c3fe63a0 100644
--- a/src/proto_alpha/lib_protocol/main.ml
+++ b/src/proto_alpha/lib_protocol/main.ml
@@ -94,35 +94,6 @@ type validation_state = Validate.validation_state
 
 type application_state = Apply.application_state
 
-let init_allowed_consensus_operations ctxt ~endorsement_level
-    ~preendorsement_level =
-  let open Lwt_result_syntax in
-  let open Alpha_context in
-  let* ctxt = Delegate.prepare_stake_distribution ctxt in
-  let* ctxt, allowed_endorsements, allowed_preendorsements =
-    if Level.(endorsement_level = preendorsement_level) then
-      let* ctxt, slots =
-        Baking.endorsing_rights_by_first_slot ctxt endorsement_level
-      in
-      let consensus_operations = slots in
-      return (ctxt, consensus_operations, consensus_operations)
-    else
-      let* ctxt, endorsements =
-        Baking.endorsing_rights_by_first_slot ctxt endorsement_level
-      in
-      let* ctxt, preendorsements =
-        Baking.endorsing_rights_by_first_slot ctxt preendorsement_level
-      in
-      return (ctxt, endorsements, preendorsements)
-  in
-  let ctxt =
-    Consensus.initialize_consensus_operation
-      ctxt
-      ~allowed_endorsements
-      ~allowed_preendorsements
-  in
-  return ctxt
-
 (** Circumstances and relevant information for [begin_validation] and
     [begin_application] below. *)
 type mode =
@@ -138,6 +109,83 @@ type mode =
       timestamp : Time.t;
     }
 
+(** Initialize the consensus rights by first slot for modes that are
+    about the validation/application of a block: application, partial
+    validation, and full construction.
+
+    In these modes, endorsements must point to the predecessor's level
+    and preendorsements, if any, to the block's level. *)
+let init_consensus_rights_for_block ctxt mode ~predecessor_level =
+  let open Lwt_result_syntax in
+  let open Alpha_context in
+  let* ctxt, endorsements_map =
+    Baking.endorsing_rights_by_first_slot ctxt predecessor_level
+  in
+  let*? can_contain_preendorsements =
+    match mode with
+    | Construction _ | Partial_construction _ -> ok true
+    | Application block_header | Partial_validation block_header ->
+        (* A preexisting block, which has a complete and correct block
+           header, can only contain preendorsements when the locked
+           round in the fitness has an actual value. *)
+        let open Result_syntax in
+        let* locked_round =
+          Fitness.locked_round_from_raw block_header.shell.fitness
+        in
+        return (Option.is_some locked_round)
+  in
+  let* ctxt, allowed_preendorsements =
+    if can_contain_preendorsements then
+      let* ctxt, preendorsements_map =
+        Baking.endorsing_rights_by_first_slot ctxt (Level.current ctxt)
+      in
+      return (ctxt, Some preendorsements_map)
+    else return (ctxt, None)
+  in
+  let ctxt =
+    Consensus.initialize_consensus_operation
+      ctxt
+      ~allowed_endorsements:(Some endorsements_map)
+      ~allowed_preendorsements
+  in
+  return ctxt
+
+(** Initialize the consensus rights for a mempool (partial
+    construction mode).
+
+    In the mempool, there are three allowed levels for both
+    endorsements and preendorsements: [predecessor_level - 1] (aka the
+    grandparent's level), [predecessor_level] (that is, the level of
+    the mempool's head), and [predecessor_level + 1] (aka the current
+    level in ctxt). *)
+let init_consensus_rights_for_mempool ctxt ~predecessor_level =
+  let open Lwt_result_syntax in
+  let open Alpha_context in
+  (* We don't want to compute the tables by first slot for all three
+     possible levels because it is time-consuming. So we don't compute
+     any [allowed_endorsements] or [allowed_preendorsements] tables. *)
+  let ctxt =
+    Consensus.initialize_consensus_operation
+      ctxt
+      ~allowed_endorsements:None
+      ~allowed_preendorsements:None
+  in
+  (* However, we want to ensure that the cycle rights are loaded in
+     the context, so that {!Stake_distribution.slot_owner} doesn't
+     have to initialize them each time it is called (we do this now
+     because the context is discarded at the end of the validation of
+     each operation, so we can't rely on the caching done by
+     [slot_owner] itself). *)
+  let cycle = (Level.current ctxt).cycle in
+  let* ctxt = Stake_distribution.load_sampler_for_cycle ctxt cycle in
+  (* If the cycle has changed between the grandparent level and the
+     current level, we also initialize the sampler for that
+     cycle. That way, all three allowed levels are covered. *)
+  match Level.pred ctxt predecessor_level with
+  | Some gp_level when Cycle.(gp_level.cycle <> cycle) ->
+      Stake_distribution.load_sampler_for_cycle ctxt gp_level.cycle
+  | Some _ | None -> return ctxt
+
 let prepare_ctxt ctxt mode ~(predecessor : Block_header.shell_header) =
   let open Lwt_result_syntax in
   let open Alpha_context in
@@ -153,32 +201,20 @@ let prepare_ctxt ctxt mode ~(predecessor : Block_header.shell_header) =
   in
   let*? predecessor_raw_level = Raw_level.of_int32 predecessor.level in
   let predecessor_level = Level.from_raw ctxt predecessor_raw_level in
-  (* During block (full or partial) application or full construction,
-     endorsements must be for [predecessor_level] and preendorsements,
-     if any, for the block's level. In the mempool (partial
-     construction), both endorsements and preendorsements are expected
-     to be for [predecessor_level] (that is, head's level) most of the
-     time, although operations that are one level before or after
-     [predecessor_level] are also accepted. *)
-  let preendorsement_level =
+  let* ctxt = Delegate.prepare_stake_distribution ctxt in
+  let* ctxt =
     match mode with
     | Application _ | Partial_validation _ | Construction _ ->
-        Level.current ctxt
-    | Partial_construction _ -> predecessor_level
-  in
-  let* ctxt =
-    init_allowed_consensus_operations
-      ctxt
-      ~endorsement_level:predecessor_level
-      ~preendorsement_level
+        init_consensus_rights_for_block ctxt mode ~predecessor_level
+    | Partial_construction _ ->
+        init_consensus_rights_for_mempool ctxt ~predecessor_level
   in
   Dal_apply.initialisation ~level:predecessor_level ctxt >>=? fun ctxt ->
   return
     ( ctxt,
       migration_balance_updates,
       migration_operation_results,
-      predecessor_level,
-      predecessor_raw_level )
+      predecessor_level )
 
 let begin_validation ctxt chain_id mode ~predecessor =
   let open Lwt_result_syntax in
@@ -186,8 +222,7 @@ let begin_validation ctxt chain_id mode ~predecessor =
   let* ( ctxt,
          _migration_balance_updates,
          _migration_operation_results,
-         predecessor_level,
-         _predecessor_raw_level ) =
+         predecessor_level ) =
     prepare_ctxt ctxt ~predecessor mode
   in
   let predecessor_timestamp = predecessor.timestamp in
@@ -267,8 +302,7 @@ let begin_application ctxt chain_id mode ~predecessor =
   let* ( ctxt,
          migration_balance_updates,
          migration_operation_results,
-         predecessor_level,
-         predecessor_raw_level ) =
+         predecessor_level ) =
     prepare_ctxt ctxt ~predecessor mode
   in
   let predecessor_timestamp = predecessor.timestamp in
@@ -302,7 +336,6 @@ let begin_application ctxt chain_id mode ~predecessor =
         chain_id
         ~migration_balance_updates
         ~migration_operation_results
-        ~predecessor_level:predecessor_raw_level
         ~predecessor_hash
         ~predecessor_fitness
 
@@ -398,8 +431,7 @@ module Mempool = struct
     let* ( ctxt,
            _migration_balance_updates,
            _migration_operation_results,
-           head_level,
-           _head_raw_level ) =
+           head_level ) =
       (* We use Partial_construction to factorize the [prepare_ctxt]. *)
       prepare_ctxt
         ctxt
diff --git a/src/proto_alpha/lib_protocol/raw_context.ml b/src/proto_alpha/lib_protocol/raw_context.ml
index 7e1e67fe8b77d81e1f73ebd76f0339c6ffa5582b..e728649641e8d64ba45e6264f35d6dd312847d4b 100644
--- a/src/proto_alpha/lib_protocol/raw_context.ml
+++ b/src/proto_alpha/lib_protocol/raw_context.ml
@@ -87,16 +87,18 @@ module Raw_consensus = struct
   type t = {
     current_endorsement_power : int;
         (** Number of endorsement slots recorded for the current block. *)
-    allowed_endorsements : (consensus_pk * int) Slot_repr.Map.t;
+    allowed_endorsements : (consensus_pk * int) Slot_repr.Map.t option;
         (** Endorsements rights for the current block. Only an endorsement
             for the lowest slot in the block can be recorded. The map
             associates to each initial slot the [pkh] associated to this
-            slot with its power. *)
-    allowed_preendorsements : (consensus_pk * int) Slot_repr.Map.t;
+            slot with its power. This is [None] only in mempool mode. *)
+    allowed_preendorsements : (consensus_pk * int) Slot_repr.Map.t option;
         (** Preendorsements rights for the current block. Only a preendorsement
             for the lowest slot in the block can be recorded. The map
             associates to each initial slot the [pkh] associated to this
-            slot with its power. *)
+            slot with its power. This is [None] only in mempool mode, or in
+            application mode when there is no locked round (so the block
+            cannot contain any preendorsements). *)
     endorsements_seen : Slot_repr.Set.t;
         (** Record the endorsements already seen. Only initial slots are indexed. *)
     preendorsements_seen : Slot_repr.Set.t;
@@ -123,8 +125,8 @@ module Raw_consensus = struct
   let empty : t =
     {
       current_endorsement_power = 0;
-      allowed_endorsements = Slot_repr.Map.empty;
-      allowed_preendorsements = Slot_repr.Map.empty;
+      allowed_endorsements = Some Slot_repr.Map.empty;
+      allowed_preendorsements = Some Slot_repr.Map.empty;
       endorsements_seen = Slot_repr.Set.empty;
       preendorsements_seen = Slot_repr.Set.empty;
       locked_round_evidence = None;
@@ -1328,16 +1330,18 @@ module type CONSENSUS = sig
 
   type consensus_pk
 
-  val allowed_endorsements : t -> (consensus_pk * int) slot_map
+  val allowed_endorsements : t -> (consensus_pk * int) slot_map option
 
-  val allowed_preendorsements : t -> (consensus_pk * int) slot_map
+  val allowed_preendorsements : t -> (consensus_pk * int) slot_map option
+
+  type error += Slot_map_not_found of {loc : string}
 
   val current_endorsement_power : t -> int
 
   val initialize_consensus_operation :
     t ->
-    allowed_endorsements:(consensus_pk * int) slot_map ->
-    allowed_preendorsements:(consensus_pk * int) slot_map ->
+    allowed_endorsements:(consensus_pk * int) slot_map option ->
+    allowed_preendorsements:(consensus_pk * int) slot_map option ->
     t
 
   val record_endorsement : t -> initial_slot:slot -> power:int -> t tzresult
@@ -1419,6 +1423,18 @@ module Consensus :
   let[@inline] set_endorsement_branch ctxt branch =
     update_consensus_with ctxt (fun ctxt ->
         Raw_consensus.set_endorsement_branch ctxt branch)
+
+  type error += Slot_map_not_found of {loc : string}
+
+  let () =
+    register_error_kind
+      `Permanent
+      ~id:"raw_context.consensus.slot_map_not_found"
+      ~title:"Slot map not found"
+      ~description:"Pre-computed map by first slot not found."
+      Data_encoding.(obj1 (req "loc" (string Plain)))
+      (function Slot_map_not_found {loc} -> Some loc | _ -> None)
+      (fun loc -> Slot_map_not_found {loc})
 end
 
 module Tx_rollup = struct
diff --git a/src/proto_alpha/lib_protocol/raw_context.mli b/src/proto_alpha/lib_protocol/raw_context.mli
index db67547aea8480a6f9162cce6b6549170dccec88..b53538adbaff6f2d9327fbcc58b9f615a5ab9b1b 100644
--- a/src/proto_alpha/lib_protocol/raw_context.mli
+++ b/src/proto_alpha/lib_protocol/raw_context.mli
@@ -260,7 +260,10 @@ val record_dictator_proposal_seen : t -> t
 val dictator_proposal_seen : t -> bool
 
 (** [init_sampler_for_cycle ctxt cycle seed state] caches the seeded stake
-    sampler (a.k.a. [seed, state]) for [cycle] in memory for quick access. *)
+    sampler (a.k.a. [seed, state]) for [cycle] in memory for quick access.
+
+    @return [Error Sampler_already_set] if the sampler was already
+    cached. *)
 val init_sampler_for_cycle :
   t -> Cycle_repr.t -> Seed_repr.seed -> consensus_pk Sampler.t -> t tzresult
 
@@ -306,12 +309,15 @@ module type CONSENSUS = sig
   (** Returns a map where each endorser's pkh is associated to the
      list of its endorsing slots (in decreasing order) for a given
      level. *)
-  val allowed_endorsements : t -> (consensus_pk * int) slot_map
+  val allowed_endorsements : t -> (consensus_pk * int) slot_map option
 
   (** Returns a map where each endorser's pkh is associated to the
      list of its endorsing slots (in decreasing order) for a given
      level. *)
-  val allowed_preendorsements : t -> (consensus_pk * int) slot_map
+  val allowed_preendorsements : t -> (consensus_pk * int) slot_map option
+
+  (** Missing pre-computed map by first slot. This error should not happen. *)
+  type error += Slot_map_not_found of {loc : string}
 
   (** [endorsement power ctx] returns the endorsement power of the
      current block. *)
@@ -322,8 +328,8 @@ module type CONSENSUS = sig
      any consensus operation.  *)
   val initialize_consensus_operation :
     t ->
-    allowed_endorsements:(consensus_pk * int) slot_map ->
-    allowed_preendorsements:(consensus_pk * int) slot_map ->
+    allowed_endorsements:(consensus_pk * int) slot_map option ->
+    allowed_preendorsements:(consensus_pk * int) slot_map option ->
     t
 
   (** [record_endorsement ctx ~initial_slot ~power] records an
diff --git a/src/proto_alpha/lib_protocol/raw_level_repr.ml b/src/proto_alpha/lib_protocol/raw_level_repr.ml
index 24ac0327882eb05f10cab7a13eee9434d448a66b..cabfb2040580c663a898a11629516e1b5aaa4c8d 100644
--- a/src/proto_alpha/lib_protocol/raw_level_repr.ml
+++ b/src/proto_alpha/lib_protocol/raw_level_repr.ml
@@ -61,6 +61,8 @@ let sub l i =
 
 let pred l = if l = 0l then None else Some (Int32.pred l)
 
+let pred_dontreturnzero l = if l <= 1l then None else Some (Int32.pred l)
+
 let diff = Int32.sub
 
 let to_int32 l = l
diff --git a/src/proto_alpha/lib_protocol/raw_level_repr.mli b/src/proto_alpha/lib_protocol/raw_level_repr.mli
index cdfcb175d57d435abc66b904e74ccfd7e35e9bb3..5be1510c03b219c7a674d32ba8fecebefb52820e 100644
--- a/src/proto_alpha/lib_protocol/raw_level_repr.mli
+++ b/src/proto_alpha/lib_protocol/raw_level_repr.mli
@@ -63,6 +63,9 @@ val succ : raw_level -> raw_level
 
 val pred : raw_level -> raw_level option
 
+(** Return the predecessor of [l] when [l >= 2], otherwise return [None]. *)
+val pred_dontreturnzero : raw_level -> raw_level option
+
 (** [add l i] i must be positive *)
 val add : raw_level -> int -> raw_level
 
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_endorsement.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_endorsement.ml
index 9e5bc24de94edc155a3ce02b14089b9fc38b2bc3..b62fb4320b0a5b686615c9b364bdf5430986e94a 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_endorsement.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_double_endorsement.ml
@@ -26,9 +26,7 @@
 (** Testing
     -------
     Component:    Protocol (double endorsement)
-    Invocation:   dune exec \
-                  src/proto_alpha/lib_protocol/test/integration/consensus/main.exe \
-                  -- test "^double endorsement$"
+    Invocation:   dune exec src/proto_alpha/lib_protocol/test/integration/consensus/main.exe -- --test "alpha: double endorsement"
     Subject:      Double endorsement evidence operation may happen when an
                   endorser endorsed two different blocks on the same level.
 *)
@@ -149,6 +147,35 @@ let test_different_branch () =
   in
   Block.bake ~operation blk >>=? fun _blk -> return_unit
 
+(** Check that a double (pre)endorsement evidence succeeds when the
+    operations have distinct slots (that both belong to the delegate)
+    and are otherwise identical. *)
+let test_different_slots () =
+  let open Lwt_result_syntax in
+  let* genesis, _contracts = Context.init2 ~consensus_threshold:0 () in
+  let* blk = Block.bake genesis in
+  let* endorsers = Context.get_endorsers (B blk) in
+  let delegate, slot1, slot2 =
+    (* Find an endorser with more than 1 slot. *)
+    WithExceptions.Option.get
+      ~loc:__LOC__
+      (List.find_map
+         (fun (endorser : RPC.Validators.t) ->
+           match endorser.slots with
+           | slot1 :: slot2 :: _ -> Some (endorser.delegate, slot1, slot2)
+           | _ -> None)
+         endorsers)
+  in
+  let* endorsement1 = Op.raw_endorsement ~delegate ~slot:slot1 blk in
+  let* endorsement2 = Op.raw_endorsement ~delegate ~slot:slot2 blk in
+  let doubleA = double_endorsement (B blk) endorsement1 endorsement2 in
+  let* (_ : Block.t) = Block.bake ~operation:doubleA blk in
+  let* preendorsement1 = Op.raw_preendorsement ~delegate ~slot:slot1 blk in
+  let* preendorsement2 = Op.raw_preendorsement ~delegate ~slot:slot2 blk in
+  let doubleB = double_preendorsement (B blk) preendorsement1 preendorsement2 in
+  let* (_ : Block.t) = Block.bake ~operation:doubleB blk in
+  return_unit
+
 (** Say a delegate double-endorses twice and say the 2 evidences are timely
    included. Then the delegate can no longer bake. *)
 let test_two_double_endorsement_evidences_leadsto_no_bake () =
@@ -273,16 +300,10 @@ let test_different_delegates () =
   block_fork genesis >>=? fun (blk_1, blk_2) ->
   Block.bake blk_1 >>=? fun blk_a ->
   Block.bake blk_2 >>=? fun blk_b ->
-  Context.get_endorser (B blk_a) >>=? fun (endorser_a, _a_slots) ->
   Context.get_first_different_endorsers (B blk_b)
-  >>=? fun (endorser_b1c, endorser_b2c) ->
-  let endorser_b =
-    if Signature.Public_key_hash.( = ) endorser_a endorser_b1c.delegate then
-      endorser_b2c.delegate
-    else endorser_b1c.delegate
-  in
-  Op.raw_endorsement ~delegate:endorser_a blk_a >>=? fun e_a ->
-  Op.raw_endorsement ~delegate:endorser_b blk_b >>=? fun e_b ->
+  >>=? fun (endorser_a, endorser_b) ->
+  Op.raw_endorsement ~delegate:endorser_a.delegate blk_a >>=? fun e_a ->
+  Op.raw_endorsement ~delegate:endorser_b.delegate blk_b >>=? fun e_b ->
   Block.bake ~operation:(Operation.pack e_b) blk_b >>=? fun (_ : Block.t) ->
   double_endorsement (B blk_b) e_a e_b |> fun operation ->
   Block.bake ~operation blk_b >>= fun res ->
@@ -499,6 +520,10 @@ let tests =
       "valid evidence with same (pre)endorsements on different branches"
       `Quick
       test_different_branch;
+    Tztest.tztest
+      "valid evidence with same (pre)endorsements on different slots"
+      `Quick
+      test_different_slots;
     Tztest.tztest
       "2 valid double endorsement evidences lead to not being able to bake"
       `Quick
diff --git a/src/proto_alpha/lib_protocol/test/integration/consensus/test_endorsement.ml b/src/proto_alpha/lib_protocol/test/integration/consensus/test_endorsement.ml
index 2758d3225de7f4b9c140c19eb7a9b6b7b554d9c0..ea39907d1ed44bb6d3351aa26751bf3c5da24def 100644
--- a/src/proto_alpha/lib_protocol/test/integration/consensus/test_endorsement.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/consensus/test_endorsement.ml
@@ -26,9 +26,7 @@
 (** Testing
     -------
     Component:  Protocol (endorsement)
-    Invocation: dune exec \
-                src/proto_alpha/lib_protocol/test/integration/consensus/main.exe \
-                -- test "^endorsement$"
+    Invocation: dune exec src/proto_alpha/lib_protocol/test/integration/consensus/main.exe -- --test "alpha: endorsement"
     Subject:    Endorsing a block adds an extra layer of confidence
                 to the Tezos' PoS algorithm. The block endorsing
                 operation must be included in the following block.
@@ -98,6 +96,55 @@ let test_fitness_gap () =
   in
   Assert.equal_int32 ~loc:__LOC__ level_diff 1l
 
+(** Return a delegate and its second smallest slot for the level of [block]. *)
+let delegate_and_second_slot block =
+  let open Lwt_result_syntax in
+  let* endorsers = Context.get_endorsers (B block) in
+  let delegate, slots =
+    (* Find an endorser with more than 1 slot. *)
+    WithExceptions.Option.get
+      ~loc:__LOC__
+      (List.find_map
+         (fun {RPC.Validators.delegate; slots; _} ->
+           if Compare.List_length_with.(slots > 1) then Some (delegate, slots)
+           else None)
+         endorsers)
+  in
+  (* Check that the slots are sorted and have no duplicates. *)
+  let rec check_sorted = function
+    | [] | [_] -> true
+    | x :: (y :: _ as t) -> Slot.compare x y < 0 && check_sorted t
+  in
+  assert (check_sorted slots) ;
+  let slot =
+    match slots with [] | [_] -> assert false | _ :: slot :: _ -> slot
+  in
+  return (delegate, slot)
+
+(** Test that the mempool accepts endorsements with a non-normalized
+    slot (that is, a slot that belongs to the delegate but is not the
+    delegate's smallest slot) at all three allowed levels for
+    endorsements (and various rounds). *)
+let test_mempool_second_slot () =
+  let open Lwt_result_syntax in
+  let* _genesis, grandparent = init_genesis () in
+  let* predecessor = Block.bake grandparent ~policy:(By_round 3) in
+  let* future_block = Block.bake predecessor ~policy:(By_round 5) in
+  let check_non_smallest_slot_ok loc endorsed_block =
+    let* delegate, slot = delegate_and_second_slot endorsed_block in
+    Consensus_helpers.test_consensus_operation
+      ~loc
+      ~endorsed_block
+      ~predecessor
+      ~delegate
+      ~slot
+      Endorsement
+      Mempool
+  in
+  let* () = check_non_smallest_slot_ok __LOC__ grandparent in
+  let* () = check_non_smallest_slot_ok __LOC__ predecessor in
+  check_non_smallest_slot_ok __LOC__ future_block
+
 (** {1 Negative tests}
 
     The following test scenarios are supposed to raise errors. *)
@@ -121,54 +168,46 @@ let test_negative_slot () =
       | Data_encoding.Binary.Write_error _ -> return_unit | e -> Lwt.fail e)
 
 (** Endorsement with a non-normalized slot (that is, a slot that
-    belongs to the delegate but is not the delegate's smallest slot). *)
+    belongs to the delegate but is not the delegate's smallest slot).
+    It should fail in application and construction modes, but be
+    accepted in mempool mode. *)
 let test_not_smallest_slot () =
   let open Lwt_result_syntax in
   let* _genesis, b = init_genesis () in
-  let* endorsers = Context.get_endorsers (B b) in
-  let delegate, slots =
-    (* Find an endorser with more than 1 slot. *)
-    WithExceptions.Option.get
-      ~loc:__LOC__
-      (List.find_map
-         (fun {RPC.Validators.delegate; slots; _} ->
-           if Compare.List_length_with.(slots > 1) then Some (delegate, slots)
-           else None)
-         endorsers)
-  in
-  (* Check that the slots are sorted and have no duplicates. *)
-  let rec check_sorted = function
-    | [] | [_] -> true
-    | x :: (y :: _ as t) -> Slot.compare x y < 0 && check_sorted t
-  in
-  assert (check_sorted slots) ;
-  let slot =
-    match slots with [] | [_] -> assert false | _ :: slot :: _ -> slot
+  let* delegate, slot = delegate_and_second_slot b in
+  let error_wrong_slot = function
+    | Validate_errors.Consensus.Wrong_slot_used_for_consensus_operation
+        {kind; _}
+      when kind = Validate_errors.Consensus.Endorsement ->
+        true
+    | _ -> false
   in
-  Consensus_helpers.test_consensus_operation_all_modes
+  Consensus_helpers.test_consensus_operation_all_modes_different_outcomes
     ~loc:__LOC__
     ~endorsed_block:b
     ~delegate
     ~slot
-    ~error:(function
-      | Validate_errors.Consensus.Wrong_slot_used_for_consensus_operation
-          {kind; _}
-        when kind = Validate_errors.Consensus.Endorsement ->
-          true
-      | _ -> false)
+    ~application_error:error_wrong_slot
+    ~construction_error:error_wrong_slot
+    ?mempool_error:None
     Endorsement
 
-(** Endorsement with a slot that does not belong to the delegate. *)
-let test_other_delegate_slot () =
+let delegate_and_someone_elses_slot block =
   let open Lwt_result_syntax in
-  let* _genesis, b = init_genesis () in
-  let* endorsers = Context.get_endorsers (B b) in
+  let* endorsers = Context.get_endorsers (B block) in
   let delegate, other_delegate_slot =
     match endorsers with
     | [] | [_] -> assert false (* at least two delegates with rights *)
     | {delegate; _} :: {slots; _} :: _ ->
         (delegate, WithExceptions.Option.get ~loc:__LOC__ (List.hd slots))
   in
+  return (delegate, other_delegate_slot)
+
+(** Endorsement with a slot that does not belong to the delegate. *)
+let test_not_own_slot () =
+  let open Lwt_result_syntax in
+  let* _genesis, b = init_genesis () in
+  let* delegate, other_delegate_slot = delegate_and_someone_elses_slot b in
   Consensus_helpers.test_consensus_operation_all_modes
     ~loc:__LOC__
     ~endorsed_block:b
@@ -178,6 +217,29 @@ let test_other_delegate_slot () =
       | Alpha_context.Operation.Invalid_signature -> true | _ -> false)
     Endorsement
 
+(** In mempool mode, also test endorsements with a slot that does not
+    belong to the delegate for various allowed levels and rounds. *)
+let test_mempool_not_own_slot () =
+  let open Lwt_result_syntax in
+  let* _genesis, grandparent = init_genesis ~policy:(By_round 2) () in
+  let* predecessor = Block.bake grandparent ~policy:(By_round 1) in
+  let* future_block = Block.bake predecessor in
+  let check_not_own_slot_fails loc b =
+    let* delegate, other_delegate_slot = delegate_and_someone_elses_slot b in
+    Consensus_helpers.test_consensus_operation
+      ~loc
+      ~endorsed_block:b
+      ~delegate
+      ~slot:other_delegate_slot
+      ~error:(function
+        | Alpha_context.Operation.Invalid_signature -> true | _ -> false)
+      Endorsement
+      Mempool
+  in
+  let* () = check_not_own_slot_fails __LOC__ grandparent in
+  let* () = check_not_own_slot_fails __LOC__ predecessor in
+  check_not_own_slot_fails __LOC__ future_block
+
 (** {2 Wrong level} *)
 
 let error_old_level = function
@@ -577,11 +639,13 @@ let tests =
     Tztest.tztest "Arbitrary branch" `Quick test_arbitrary_branch;
     Tztest.tztest "Non-zero round" `Quick test_non_zero_round;
     Tztest.tztest "Fitness gap" `Quick test_fitness_gap;
+    Tztest.tztest "Mempool: non-smallest slot" `Quick test_mempool_second_slot;
     (* Negative tests *)
     (* Wrong slot *)
     Tztest.tztest "Endorsement with slot -1" `Quick test_negative_slot;
     Tztest.tztest "Non-normalized slot" `Quick test_not_smallest_slot;
-    Tztest.tztest "Slot of another delegate" `Quick test_other_delegate_slot;
+    Tztest.tztest "Not own slot" `Quick test_not_own_slot;
+    Tztest.tztest "Mempool: not own slot" `Quick test_mempool_not_own_slot;
     (* Wrong level *)
     Tztest.tztest "One level too old" `Quick test_one_level_too_old;
     Tztest.tztest "Two levels too old" `Quick test_two_levels_too_old;
diff --git a/src/proto_alpha/lib_protocol/validate.ml b/src/proto_alpha/lib_protocol/validate.ml
index 2da01eec3d825e51d3002381b6020078157ab784..8e7663c14c9f81ffe99ce7ae462162b7381e68e0 100644
--- a/src/proto_alpha/lib_protocol/validate.ml
+++ b/src/proto_alpha/lib_protocol/validate.ml
@@ -29,8 +29,8 @@ open Alpha_context
 type consensus_info = {
   predecessor_level : Raw_level.t;
   predecessor_round : Round.t;
-  preendorsement_slot_map : (Consensus_key.pk * int) Slot.Map.t;
-  endorsement_slot_map : (Consensus_key.pk * int) Slot.Map.t;
+  preendorsement_slot_map : (Consensus_key.pk * int) Slot.Map.t option;
+  endorsement_slot_map : (Consensus_key.pk * int) Slot.Map.t option;
 }
 
 let init_consensus_info ctxt (predecessor_level, predecessor_round) =
@@ -440,9 +440,12 @@ module Consensus = struct
       (Zero_frozen_deposits delegate_pkh)
 
   let get_delegate_details slot_map kind slot =
-    Result.of_option
-      (Slot.Map.find slot slot_map)
-      ~error:(trace_of_error (Wrong_slot_used_for_consensus_operation {kind}))
+    match slot_map with
+    | None -> error (Consensus.Slot_map_not_found {loc = __LOC__})
+    | Some slot_map -> (
+        match Slot.Map.find slot slot_map with
+        | None -> error (Wrong_slot_used_for_consensus_operation {kind})
+        | Some x -> ok x)
 
   (** When validating a block (ie. in [Application],
       [Partial_validation], and [Construction] modes), any
@@ -549,10 +552,17 @@ module Consensus = struct
       [predecessor_level - 1 <= op_level <= predecessor_level + 1]
       (note that [predecessor_level + 1] is also known as [current_level]).
 
-      Return the slot owner's consensus key and voting power (the
-      latter may be fake because it doesn't matter in Mempool mode, but
-      it is included to mirror the check_..._block_preendorsement
-      functions). *)
+      Note that we also don't check whether the slot is normalized
+      (that is, whether it is the delegate's smallest slot). Indeed,
+      we don't want to compute the right tables by first slot for all
+      three allowed levels. Checking the slot normalization is
+      therefore the responsability of the baker when it selects
+      the consensus operations to include in a new block. Moreover,
+      multiple endorsements pointing to the same block with different
+      slots can be punished by a double-(pre)endorsement operation.
+
+      Return the slot owner's consensus key and a fake voting power (the
+      latter won't be used anyway in Mempool mode). *)
   let check_mempool_consensus vi consensus_info kind {level; slot; _} =
     let open Lwt_result_syntax in
     let*? () =
@@ -564,28 +574,10 @@ module Consensus = struct
         error (Consensus_operation_for_future_level {kind; expected; provided})
       else ok_unit
     in
-    if Raw_level.(level = consensus_info.predecessor_level) then
-      (* The operation points to the mempool head's level, which is
-         the level for which slot maps have been pre-computed. *)
-      let slot_map =
-        match kind with
-        | Preendorsement -> consensus_info.preendorsement_slot_map
-        | Endorsement -> consensus_info.endorsement_slot_map
-        | Dal_attestation -> assert false
-      in
-      Lwt.return (get_delegate_details slot_map kind slot)
-    else
-      (* We don't have a pre-computed slot map for the operation's
-         level, so we retrieve the key directly from the context. We
-         return a fake voting power since it won't be used anyway in
-         Mempool mode. *)
-      let* (_ctxt : t), consensus_key =
-        Stake_distribution.slot_owner
-          vi.ctxt
-          (Level.from_raw vi.ctxt level)
-          slot
-      in
-      return (consensus_key, 0 (* Fake voting power *))
+    let* (_ctxt : t), consensus_key =
+      Stake_distribution.slot_owner vi.ctxt (Level.from_raw vi.ctxt level) slot
+    in
+    return (consensus_key, 0 (* Fake voting power *))
   (* We do not check that the frozen deposits are positive because this
      only needs to be true in the context of a block that actually
      contains the operation, which may not be the same as the current
@@ -1360,19 +1352,24 @@ module Anonymous = struct
           Block_payload_hash.(e1.block_payload_hash = e2.block_payload_hash)
         in
         let same_branches = Block_hash.(op1.shell.branch = op2.shell.branch) in
+        let same_slots = Slot.(e1.slot = e2.slot) in
         let ordered_hashes = Operation_hash.(op1_hash < op2_hash) in
         let is_denunciation_consistent =
           same_levels && same_rounds
-          (* Either the payloads or the branches must differ for the
-             double (pre)endorsement to be punishable. Indeed,
-             different payloads would endanger the consensus process,
-             while different branches could be used to spam mempools
-             with a lot of valid operations. On the other hand, if the
-             operations have identical levels, rounds, payloads, and
-             branches (and of course delegates), then only their
+          (* For the double (pre)endorsements to be punishable, they
+             must point to the same block (same level and round), but
+             also have at least a difference that is the delegate's
+             fault: different payloads, different branches, or
+             different slots. Note that different payloads would
+             endanger the consensus process, while different branches
+             or slots could be used to spam mempools with a lot of
+             valid operations (since the minimality of the slot in not
+             checked in mempool mode, only in block-related modes). On
+             the other hand, if the operations have identical levels,
+             rounds, payloads, branches, and slots, then only their
              signatures are different, which is not considered the
              delegate's fault and therefore is not punished. *)
-          && ((not same_payload) || not same_branches)
+          && ((not same_payload) || (not same_branches) || not same_slots)
           && (* we require an order on hashes to avoid the existence of
                    equivalent evidences *)
           ordered_hashes
diff --git a/src/proto_alpha/lib_protocol/validate_errors.ml b/src/proto_alpha/lib_protocol/validate_errors.ml
index b6026458fa9f223623acb746e32c328333493fc5..5f0c32cf4e41bdb1dc2eb1c88302bf6ab7bdde7e 100644
--- a/src/proto_alpha/lib_protocol/validate_errors.ml
+++ b/src/proto_alpha/lib_protocol/validate_errors.ml
@@ -305,18 +305,7 @@ module Consensus = struct
       (fun (block_round, provided) ->
         Preendorsement_round_too_high {block_round; provided}) ;
     register_error_kind
-      (* TODO: https://gitlab.com/tezos/tezos/-/issues/5061
-
-         The classification of this error has been changed to Branch
-         because it is possible for a previously valid operation to
-         trigger this error during reclassification on a new
-         head. This could lead to the unwarranted kicking of a peer if
-         this error were Permanent.
-
-         The classification should be set back to Permanent once the
-         mempool checks the slot normalization more consistently
-         across all levels. *)
-      `Branch
+      `Permanent
       ~id:"validate.wrong_slot_for_consensus_operation"
       ~title:"Wrong slot for consensus operation"
       ~description:"Wrong slot used for a preendorsement or endorsement."