[commit: ghc] master: Fix #7919 (again) (7cf87df)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7cf87dfbf93f9839fa1e3b66a0233ac86f85a5f7/ghc

>---------------------------------------------------------------

commit 7cf87dfbf93f9839fa1e3b66a0233ac86f85a5f7
Author: Simon Marlow <smarlow at fb.com>
Date:   Thu Jul 30 07:34:43 2015 -0700

    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


>---------------------------------------------------------------

7cf87dfbf93f9839fa1e3b66a0233ac86f85a5f7
 rts/sm/GCUtils.c          | 48 ++++++++++++++++++++++++++++++++++-------------
 testsuite/tests/rts/all.T |  1 -
 2 files changed, 35 insertions(+), 14 deletions(-)

diff --git a/rts/sm/GCUtils.c b/rts/sm/GCUtils.c
index 84a620e..1c6a93c 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 0e891e8..72566d1 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])