diff --git a/includes/rts/storage/Block.h b/includes/rts/storage/Block.h
index d6b440d862bf69cfe849d19b407887d06dedf38d..d46e8e6282d351cf7d1ede86f222e002732a3657 100644
--- a/includes/rts/storage/Block.h
+++ b/includes/rts/storage/Block.h
@@ -112,8 +112,6 @@ typedef struct bdescr_ {
         StgPtr  scan;          // scan pointer for copying GC
     } u;
 
-    struct generation_ *gen;   // generation
-
     StgWord16 gen_no;          // gen->no, cached
     StgWord16 dest_no;         // number of destination generation
     StgWord16 node;            // which memory node does this block live on?
@@ -124,9 +122,9 @@ typedef struct bdescr_ {
                                // (if group head, 0 otherwise)
 
 #if SIZEOF_VOID_P == 8
-    StgWord32 _padding[5];
+    StgWord32 _padding[7];
 #else
-    StgWord32 _padding[1];
+    StgWord32 _padding[2];
 #endif
 } bdescr;
 #endif
diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h
index 7931433019869f2fe13e884441dd030a348c421f..45e5142ba5e8241bbcf78ce90b9115e6fcf97e69 100644
--- a/includes/rts/storage/GC.h
+++ b/includes/rts/storage/GC.h
@@ -244,7 +244,6 @@ extern bool keepCAFs;
 
 INLINE_HEADER void initBdescr(bdescr *bd, generation *gen, generation *dest)
 {
-    bd->gen     = gen;
     bd->gen_no  = gen->no;
     bd->dest_no = dest->no;
 
diff --git a/rts/Arena.c b/rts/Arena.c
index 799106981a4d639717007e81e63cc9b9b60c8df2..7435c44307fc053835f66b021580cf9efa78bc70 100644
--- a/rts/Arena.c
+++ b/rts/Arena.c
@@ -85,7 +85,6 @@ arenaAlloc( Arena *arena, size_t size )
         arena_blocks += req_blocks;
 
         bd->gen_no  = 0;
-        bd->gen     = NULL;
         bd->dest_no = 0;
         bd->flags   = 0;
         bd->free    = bdescr_start(bd);
diff --git a/rts/Schedule.c b/rts/Schedule.c
index 77aca0072af01c46df3efff2d4b74373f1efc6b9..fc081a6c8f3d2b7f84b64abd01f89f4ef44ed158 100644
--- a/rts/Schedule.c
+++ b/rts/Schedule.c
@@ -3140,7 +3140,7 @@ resurrectThreads (StgTSO *threads)
     for (tso = threads; tso != END_TSO_QUEUE; tso = next) {
         next = tso->global_link;
 
-        gen = Bdescr((P_)tso)->gen;
+        gen = &generations[Bdescr((P_)tso)->gen_no];
         tso->global_link = gen->threads;
         gen->threads = tso;
 
diff --git a/rts/sm/BlockAlloc.c b/rts/sm/BlockAlloc.c
index bc60d2969eefa614c0d428c3a9527d95b6c22235..37a517f285fa36b624b7004e037db353ac860edc 100644
--- a/rts/sm/BlockAlloc.c
+++ b/rts/sm/BlockAlloc.c
@@ -56,7 +56,6 @@ static void  initMBlock(void *mblock, uint32_t node);
    The following fields are not used by the allocator:
      bd->flags
      bd->gen_no
-     bd->gen
      bd->dest
 
   Exceptions: we don't maintain invariants for all the blocks within a
@@ -792,7 +791,6 @@ freeGroup(bdescr *p)
   node = p->node;
 
   p->free = (void *)-1;  /* indicates that this block is free */
-  p->gen = NULL;
   p->gen_no = 0;
   /* fill the block group with garbage if sanity checking is on */
   IF_DEBUG(zero_on_gc, memset(bdescr_start(p), 0xaa, (W_)p->blocks * BLOCK_SIZE));
diff --git a/rts/sm/CNF.c b/rts/sm/CNF.c
index c15b1cfc978fbde4f1a1e3f98e64b08a2df1a8d5..8b66dabce8c5b0ccad52689ae5a4fc52de4eaf4f 100644
--- a/rts/sm/CNF.c
+++ b/rts/sm/CNF.c
@@ -194,7 +194,7 @@ compactAllocateBlockInternal(Capability            *cap,
     // wrong and crash in Sanity)
     if (first != NULL) {
         block = Bdescr((P_)first);
-        g = block->gen;
+        g = &generations[block->gen_no];
     } else {
         g = g0;
     }
@@ -1172,7 +1172,7 @@ compactFixupPointers(StgCompactNFData *str,
     total_blocks = str->totalW / BLOCK_SIZE_W;
 
     ACQUIRE_SM_LOCK;
-    ASSERT(bd->gen == g0);
+    ASSERT(bd->gen_no == 0);
     ASSERT(g0->n_compact_blocks_in_import >= total_blocks);
     g0->n_compact_blocks_in_import -= total_blocks;
     g0->n_compact_blocks += total_blocks;
diff --git a/rts/sm/Evac.c b/rts/sm/Evac.c
index 71bd59dea8009274ffc9a2775c58d71c69baa09e..99b95203562ec2a633f89dd7316e548496d3e45e 100644
--- a/rts/sm/Evac.c
+++ b/rts/sm/Evac.c
@@ -307,8 +307,8 @@ evacuate_large(StgPtr p)
   gen_workspace *ws;
 
   bd = Bdescr(p);
-  gen = bd->gen;
   gen_no = bd->gen_no;
+  gen = &generations[gen_no];
   ACQUIRE_SPIN_LOCK(&gen->sync);
 
   // already evacuated?
@@ -458,7 +458,7 @@ evacuate_compact (StgPtr p)
         return;
     }
 
-    gen = bd->gen;
+    gen = &generations[gen_no];
     ACQUIRE_SPIN_LOCK(&gen->sync);
 
     // already evacuated?
diff --git a/rts/sm/GC.c b/rts/sm/GC.c
index 40a6d4d0b3b2234ed176eac4f2225545ce927aff..0c150ec26058827aa62670461b537844bb6fb803 100644
--- a/rts/sm/GC.c
+++ b/rts/sm/GC.c
@@ -1642,7 +1642,6 @@ collect_pinned_object_blocks (void)
             // Mark objects as belonging to the nonmoving heap
             for (bdescr *bd = capabilities[n]->pinned_object_blocks; bd != NULL; bd = bd->link) {
                 bd->flags |= BF_NONMOVING;
-                bd->gen = oldest_gen;
                 bd->gen_no = oldest_gen->no;
                 oldest_gen->n_large_words += bd->free - bdescr_start(bd);
                 oldest_gen->n_large_blocks += bd->blocks;
diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c
index 918bc3469102f6c4636952b9eb25e30ba924b516..58f7ff7c9f0ad60d3205688838dfec02f1466ca1 100644
--- a/rts/sm/GCUtils.c
+++ b/rts/sm/GCUtils.c
@@ -141,7 +141,7 @@ push_scanned_block (bdescr *bd, gen_workspace *ws)
 {
     ASSERT(bd != NULL);
     ASSERT(bd->link == NULL);
-    ASSERT(bd->gen == ws->gen);
+    ASSERT(bd->gen_no == ws->gen->no);
     ASSERT(bd->u.scan == bd->free);
 
     if (bd->blocks == 1 &&
@@ -212,7 +212,7 @@ todo_block_full (uint32_t size, gen_workspace *ws)
 
     ASSERT(bd != NULL);
     ASSERT(bd->link == NULL);
-    ASSERT(bd->gen == ws->gen);
+    ASSERT(bd->gen_no == ws->gen->no);
 
     // We intentionally set ws->todo_lim lower than the full size of
     // the block, so that we can push out some work to the global list
diff --git a/rts/sm/MarkWeak.c b/rts/sm/MarkWeak.c
index 7475b5e6256d3b51203a8a9e2370468f96e649e2..c2e9ec260174919e5cc3ced8bc58ffec18266444 100644
--- a/rts/sm/MarkWeak.c
+++ b/rts/sm/MarkWeak.c
@@ -264,7 +264,7 @@ static bool tidyWeakList(generation *gen)
                 // Find out which generation this weak ptr is in, and
                 // move it onto the weak ptr list of that generation.
 
-                new_gen = Bdescr((P_)w)->gen;
+                new_gen = &generations[Bdescr((P_)w)->gen_no];
                 gct->evac_gen_no = new_gen->no;
                 gct->failed_to_evac = false;
 
@@ -351,7 +351,7 @@ static void tidyThreadList (generation *gen)
 
             // move this thread onto the correct threads list.
             generation *new_gen;
-            new_gen = Bdescr((P_)t)->gen;
+            new_gen = &generations[Bdescr((P_)t)->gen_no];
             t->global_link = new_gen->threads;
             new_gen->threads  = t;
         }
diff --git a/rts/sm/NonMovingMark.c b/rts/sm/NonMovingMark.c
index f07c8df84981ed50389213c74d39dd3e91fa15e2..a8491eb646a071a7b68bb54295d50b9d1f430d16 100644
--- a/rts/sm/NonMovingMark.c
+++ b/rts/sm/NonMovingMark.c
@@ -481,7 +481,7 @@ void push_closure (MarkQueue *q,
                    StgClosure **origin)
 {
 #if defined(DEBUG)
-    ASSERT(!HEAP_ALLOCED_GC(p) || (Bdescr((StgPtr) p)->gen == oldest_gen));
+    ASSERT(!HEAP_ALLOCED_GC(p) || (&generations[Bdescr((StgPtr) p)->gen_no] == oldest_gen));
     ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
     // Commenting out: too slow
     // if (RtsFlags.DebugFlags.sanity) {
@@ -511,7 +511,7 @@ void push_array (MarkQueue *q,
                  StgWord start_index)
 {
     // TODO: Push this into callers where they already have the Bdescr
-    if (HEAP_ALLOCED_GC(array) && (Bdescr((StgPtr) array)->gen != oldest_gen))
+    if (HEAP_ALLOCED_GC(array) && (&generations[Bdescr((StgPtr) array)->gen_no] != oldest_gen))
         return;
 
     MarkQueueEnt ent = {
@@ -663,7 +663,7 @@ STATIC_INLINE bool needs_upd_rem_set_mark(StgClosure *p)
 {
     // TODO: Deduplicate with mark_closure
     bdescr *bd = Bdescr((StgPtr) p);
-    if (bd->gen != oldest_gen) {
+    if (&generations[bd->gen_no] != oldest_gen) {
         return false;
     } else if (bd->flags & BF_LARGE) {
         if (! (bd->flags & BF_NONMOVING_SWEEPING)) {
@@ -1249,7 +1249,7 @@ mark_closure (MarkQueue *queue, const StgClosure *p0, StgClosure **origin)
 
     bd = Bdescr((StgPtr) p);
 
-    if (bd->gen != oldest_gen) {
+    if (&generations[bd->gen_no] != oldest_gen) {
         // Here we have an object living outside of the non-moving heap. While
         // we likely evacuated nearly everything to the nonmoving heap during
         // preparation there are nevertheless a few ways in which we might trace
diff --git a/rts/sm/NonMovingSweep.c b/rts/sm/NonMovingSweep.c
index 20b2f6b9a847af301183772daba6b21ed71dc458..190ebe722956d8f56c94718e5b292520741edaec 100644
--- a/rts/sm/NonMovingSweep.c
+++ b/rts/sm/NonMovingSweep.c
@@ -166,7 +166,7 @@ static bool is_closure_clean(StgClosure *p)
 {
     const StgInfoTable *info = get_itbl(p);
 
-#define CLEAN(ptr) (!HEAP_ALLOCED((StgClosure*) ptr) || Bdescr((StgPtr) ptr)->gen == oldest_gen)
+#define CLEAN(ptr) (!HEAP_ALLOCED((StgClosure*) ptr) || &generations[Bdescr((StgPtr) ptr)->gen_no] == oldest_gen)
 
     switch (info->type) {
     case MVAR_CLEAN:
diff --git a/rts/sm/Sanity.c b/rts/sm/Sanity.c
index ce179d86a351317b996c4fc55701fe142b13643d..87eb53f4392678992dcc993914787dbd14e07265 100644
--- a/rts/sm/Sanity.c
+++ b/rts/sm/Sanity.c
@@ -792,7 +792,7 @@ checkNurserySanity (nursery *nursery)
 
     prev = NULL;
     for (bd = nursery->blocks; bd != NULL; bd = bd->link) {
-        ASSERT(bd->gen == g0);
+        ASSERT(bd->gen_no == 0);
         ASSERT(bd->u.back == prev);
         prev = bd;
         blocks += bd->blocks;
diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 5fbf4fd70e2b89e8cd4b49929999955e9c991b66..3293adaf6adc73261fc82a7f7f1d28c086f6da96 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -434,7 +434,7 @@ scavenge_block (bdescr *bd)
   saved_eager_promotion = gct->eager_promotion;
   gct->failed_to_evac = false;
 
-  ws = &gct->gens[bd->gen->no];
+  ws = &gct->gens[bd->gen_no];
 
   p = bd->u.scan;
 
diff --git a/rts/sm/Storage.c b/rts/sm/Storage.c
index 2ecab78b5b1606a96a99412089216b71dc294331..a077529acc392e583f29c2a6db439f2ccadde3b6 100644
--- a/rts/sm/Storage.c
+++ b/rts/sm/Storage.c
@@ -744,7 +744,6 @@ resetNurseries (void)
     for (n = 0; n < n_nurseries; n++) {
         for (bd = nurseries[n].blocks; bd; bd = bd->link) {
             ASSERT(bd->gen_no == 0);
-            ASSERT(bd->gen == g0);
             ASSERT(bd->node == capNoToNumaNode(n));
             IF_DEBUG(zero_on_gc, memset(bdescr_start(bd), 0xaa, BLOCK_SIZE));
         }