1 files changed, 54 insertions, 10 deletions

diff --git a/rts/sm/Scav.c b/rts/sm/Scav.c
index 940f11fea4..10ce1e46a8 100644
--- a/rts/sm/Scav.c
+++ b/rts/sm/Scav.c
@@ -27,6 +27,7 @@
 #include "Sanity.h"
 #include "Capability.h"
 #include "LdvProfile.h"
+#include "Hash.h"
 
 #include "sm/MarkWeak.h"
 
@@ -100,6 +101,45 @@ scavengeTSO (StgTSO *tso)
     gct->eager_promotion = saved_eager;
 }
 
+/* ----------------------------------------------------------------------------
+   Scavenging compact objects
+   ------------------------------------------------------------------------- */
+
+static void
+evacuate_hash_entry(HashTable *newHash, StgWord key, const void *value)
+{
+    StgClosure *p = (StgClosure*)key;
+
+    evacuate(&p);
+    insertHashTable(newHash, (StgWord)p, value);
+}
+
+static void
+scavenge_compact(StgCompactNFData *str)
+{
+    bool saved_eager;
+    saved_eager = gct->eager_promotion;
+    gct->eager_promotion = false;
+
+    if (str->hash) {
+        HashTable *newHash = allocHashTable();
+        mapHashTable(str->hash, (void*)newHash, (MapHashFn)evacuate_hash_entry);
+        freeHashTable(str->hash, NULL);
+        str->hash = newHash;
+    }
+
+    debugTrace(DEBUG_compact,
+               "compact alive @%p, gen %d, %" FMT_Word " bytes",
+               str, Bdescr((P_)str)->gen_no, str->totalW * sizeof(W_))
+
+    gct->eager_promotion = saved_eager;
+    if (gct->failed_to_evac) {
+        ((StgClosure *)str)->header.info = &stg_COMPACT_NFDATA_DIRTY_info;
+    } else {
+        ((StgClosure *)str)->header.info = &stg_COMPACT_NFDATA_CLEAN_info;
+    }
+}
+
 /* -----------------------------------------------------------------------------
    Mutable arrays of pointers
    -------------------------------------------------------------------------- */
@@ -796,13 +836,6 @@ scavenge_block (bdescr *bd)
         break;
       }
 
-    case COMPACT_NFDATA:
-        // CompactNFData blocks live in compact lists, which we don't
-        // scavenge, because there nothing to scavenge in them
-        // so we should never ever see them
-        barf("scavenge: found unexpected Compact structure");
-        break;
-
     default:
         barf("scavenge: unimplemented/strange closure type %d @ %p",
              info->type, p);
@@ -1557,6 +1590,10 @@ scavenge_one(StgPtr p)
 #endif
       break;
 
+    case COMPACT_NFDATA:
+        scavenge_compact((StgCompactNFData*)p);
+        break;
+
     default:
         barf("scavenge_one: strange object %d", (int)(info->type));
     }
@@ -1974,11 +2011,18 @@ scavenge_large (gen_workspace *ws)
         ws->todo_large_objects = bd->link;
 
         ACQUIRE_SPIN_LOCK(&ws->gen->sync);
-        dbl_link_onto(bd, &ws->gen->scavenged_large_objects);
-        ws->gen->n_scavenged_large_blocks += bd->blocks;
+        if (bd->flags & BF_COMPACT) {
+            dbl_link_onto(bd, &ws->gen->live_compact_objects);
+            StgCompactNFData *str = ((StgCompactNFDataBlock*)bd->start)->owner;
+            ws->gen->n_live_compact_blocks += str->totalW / BLOCK_SIZE_W;
+            p = (StgPtr)str;
+        } else {
+            dbl_link_onto(bd, &ws->gen->scavenged_large_objects);
+            ws->gen->n_scavenged_large_blocks += bd->blocks;
+            p = bd->start;
+        }
         RELEASE_SPIN_LOCK(&ws->gen->sync);
 
-        p = bd->start;
         if (scavenge_one(p)) {
             if (ws->gen->no > 0) {
                 recordMutableGen_GC((StgClosure *)p, ws->gen->no);