Fix #7919 (again)

Summary:
The fix is a bit clunky, and is perhaps not the best fix, but I'm not
sure how much work it would be to fix it the other way (see comments
for more info).

Test Plan: T7919 doesn't crash

Reviewers: austin, rwbarton, ezyang, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1113

GHC Trac Issues: #7919

2 files changed, 35 insertions, 14 deletions

diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c
index 84a620e8e7..1c6a93c3b2 100644
--- a/rts/sm/GCUtils.c
+++ b/rts/sm/GCUtils.c
@@ -138,9 +138,11 @@ push_scanned_block (bdescr *bd, gen_workspace *ws)
     ASSERT(bd->gen == ws->gen);
     ASSERT(bd->u.scan == bd->free);
 
-    if (bd->start + bd->blocks * BLOCK_SIZE_W - bd->free > WORK_UNIT_WORDS)
+    if (bd->blocks == 1 &&
+        bd->start + BLOCK_SIZE_W - bd->free > WORK_UNIT_WORDS)
     {
-        // a partially full block: put it on the part_list list.
+        // A partially full block: put it on the part_list list.
+        // Only for single objects - see Note [big objects]
         bd->link = ws->part_list;
         ws->part_list = bd;
         ws->n_part_blocks += bd->blocks;
@@ -158,6 +160,35 @@ push_scanned_block (bdescr *bd, gen_workspace *ws)
     }
 }
 
+/* Note [big objects]
+
+   We can get an ordinary object (CONSTR, FUN, THUNK etc.) that is
+   larger than a block (see #7919).  Let's call these "big objects".
+   These objects don't behave like large objects - they live in
+   ordinary heap space (not the large_objects list), and are copied by
+   evacuate().
+
+   Clearly to copy one of these objects we need a block group, not an
+   ordinary block, so when alloc_todo_block() will correctly allocate a
+   block group.
+
+   The question is what to do with the space that is left at the end
+   of the block group after copying the big object into it.  We could
+   continue to copy more objects into that space, but unfortunately
+   the rest of the GC is not set up to handle objects that start in
+   the second or later blocks of a group.  We just about manage this
+   in the nursery (see scheduleHandleHeapOverflow()) so evacuate() can
+   handle this, but other parts of the GC can't.  We could probably
+   fix this, but it's a rare case, so for now we ensure that we never
+   copy objects into the second and subsequent blocks of a block
+   group.
+
+   To ensure this:
+    - alloc_todo_block() sets todo_lim to be exactly the size of the
+      large object
+    - push_scanned_block doesn't put these blocks on the part_list
+*/
+
 StgPtr
 todo_block_full (nat size, gen_workspace *ws)
 {
@@ -193,17 +224,7 @@ todo_block_full (nat size, gen_workspace *ws)
 
     // We can extend the limit for the current block if there's enough
     // room for the current object, *and* we're not into the second or
-    // subsequent block of a large block.  The second condition occurs
-    // when we evacuate an object that is larger than a block.  In
-    // that case, alloc_todo_block() sets todo_lim to be exactly the
-    // size of the large object, and we don't evacuate any more
-    // objects into this block.  The reason is that the rest of the GC
-    // is not set up to handle objects that start in the second or
-    // later blocks of a group.  We just about manage this in the
-    // nursery (see scheduleHandleHeapOverflow()) so evacuate() can
-    // handle this, but other parts of the GC can't.  We could
-    // probably fix this, but it's a rare case anyway.
-    //
+    // subsequent block of a large block (see Note [big objects]).
     can_extend =
         ws->todo_free + size <= bd->start + bd->blocks * BLOCK_SIZE_W
         && ws->todo_free < ws->todo_bd->start + BLOCK_SIZE_W;
@@ -316,6 +337,7 @@ alloc_todo_block (gen_workspace *ws, nat size)
     ws->todo_free = bd->free;
     ws->todo_lim  = stg_min(bd->start + bd->blocks * BLOCK_SIZE_W,
                             bd->free + stg_max(WORK_UNIT_WORDS,size));
+                     // See Note [big objects]
 
     debugTrace(DEBUG_gc, "alloc new todo block %p for gen  %d",
                bd->free, ws->gen->no);
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index 0e891e8f1b..72566d1fd0 100644
--- a/testsuite/tests/rts/all.T
+++ b/testsuite/tests/rts/all.T
@@ -224,7 +224,6 @@ test('ffishutdown', [ ignore_output, only_ways(['threaded1','threaded2']) ], com
 
 test('T7919', [extra_clean(['T7919A.o','T7919A.hi',
                             'T7919A.dyn_o','T7919A.dyn_hi']),
-               expect_broken_for(7919, ['optasm','dyn','optllvm']),
                when(fast(),skip) ],
              compile_and_run, [config.ghc_th_way_flags])