Compact Regions

This brings in initial support for compact regions, as described in the
ICFP 2015 paper "Efficient Communication and Collection with Compact
Normal Forms" (Edward Z. Yang et.al.) and implemented by Giovanni
Campagna.

Some things may change before the 8.2 release, but I (Simon M.) wanted
to get the main patch committed so that we can iterate.

What documentation there is is in the Data.Compact module in the new
compact package.  We'll need to extend and polish the documentation
before the release.

Test Plan:
validate
(new test cases included)

Reviewers: ezyang, simonmar, hvr, bgamari, austin

Subscribers: vikraman, Yuras, RyanGlScott, qnikst, mboes, facundominguez, rrnewton, thomie, erikd

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

GHC Trac Issues: #11493

6 files changed, 93 insertions, 1 deletions

diff --git a/includes/rts/storage/Block.h b/includes/rts/storage/Block.h
index e04cfdfec6..7d6f102ab8 100644
--- a/includes/rts/storage/Block.h
+++ b/includes/rts/storage/Block.h
@@ -154,6 +154,10 @@ typedef struct bdescr_ {
 #define BF_KNOWN     128
 /* Block was swept in the last generation */
 #define BF_SWEPT     256
+/* Block is part of a Compact */
+#define BF_COMPACT   512
+/* Maximum flag value (do not define anything higher than this!) */
+#define BF_FLAG_MAX  (1 << 15)
 
 /* Finding the block descriptor for a given block -------------------------- */
 
diff --git a/includes/rts/storage/ClosureMacros.h b/includes/rts/storage/ClosureMacros.h
index 4ebec0f45f..e485246206 100644
--- a/includes/rts/storage/ClosureMacros.h
+++ b/includes/rts/storage/ClosureMacros.h
@@ -355,6 +355,10 @@ EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco );
 EXTERN_INLINE StgWord bco_sizeW ( StgBCO *bco )
 { return bco->size; }
 
+EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str );
+EXTERN_INLINE StgWord compact_nfdata_full_sizeW ( StgCompactNFData *str )
+{ return str->totalW; }
+
 /*
  * TODO: Consider to switch return type from 'uint32_t' to 'StgWord' #8742
  *
@@ -417,6 +421,12 @@ closure_sizeW_ (const StgClosure *p, const StgInfoTable *info)
         return bco_sizeW((StgBCO *)p);
     case TREC_CHUNK:
         return sizeofW(StgTRecChunk);
+    case COMPACT_NFDATA:
+        // Nothing should ever call closure_sizeW() on a StgCompactNFData
+        // because CompactNFData is a magical object/list-of-objects that
+        // requires special paths pretty much everywhere in the GC
+        barf("closure_sizeW() called on a StgCompactNFData. "
+             "This should never happen.");
     default:
         return sizeW_fromITBL(info);
     }
diff --git a/includes/rts/storage/ClosureTypes.h b/includes/rts/storage/ClosureTypes.h
index 4f66de318b..f5e96e7500 100644
--- a/includes/rts/storage/ClosureTypes.h
+++ b/includes/rts/storage/ClosureTypes.h
@@ -82,6 +82,7 @@
 #define SMALL_MUT_ARR_PTRS_DIRTY      61
 #define SMALL_MUT_ARR_PTRS_FROZEN0    62
 #define SMALL_MUT_ARR_PTRS_FROZEN     63
-#define N_CLOSURE_TYPES         64
+#define COMPACT_NFDATA          64
+#define N_CLOSURE_TYPES         65
 
 #endif /* RTS_STORAGE_CLOSURETYPES_H */
diff --git a/includes/rts/storage/Closures.h b/includes/rts/storage/Closures.h
index f880b5c876..4dda0a7f3a 100644
--- a/includes/rts/storage/Closures.h
+++ b/includes/rts/storage/Closures.h
@@ -419,4 +419,50 @@ typedef struct MessageBlackHole_ {
     StgClosure *bh;
 } MessageBlackHole;
 
+// This is not a closure, it a bare
+// structure that lives at the beginning of
+// each consecutive block group in a
+// compact structure
+//
+// See Note [Compact Normal Forms] for details
+typedef struct StgCompactNFDataBlock_ {
+    struct StgCompactNFDataBlock_ *self; // the address of this block
+                                         // this is copied over to the receiving
+                                         // end when serializing a compact, so
+                                         // the receiving end can allocate the
+                                         // block at best as it can, and then
+                                         // verify if pointer adjustment is
+                                         // needed or not by comparing self with
+                                         // the actual address; the same data
+                                         // is sent over as SerializedCompact
+                                         // metadata, but having it here
+                                         // simplifies the fixup implementation
+    struct StgCompactNFData_ *owner; // the closure who owns this
+                                     // block (used in objectGetCompact)
+    struct StgCompactNFDataBlock_ *next; // chain of blocks used for
+                                         // serialization and freeing
+} StgCompactNFDataBlock;
+
+typedef struct StgCompactNFData_ {
+    StgHeader              header; // for sanity and other checks in practice,
+                                   // nothing should ever need the compact info
+                                   // pointer (we don't even need fwding
+                                   // pointers because it's a large object)
+    StgWord                totalW; // for proper accounting in evac, includes
+                                   // slop, and removes the first block in
+                                   // larger than megablock allocation
+                                   // essentially meaningless, but if we got it
+                                   // wrong sanity would complain loudly
+    StgWord                totalDataW; // for stats/profiling only, it's the
+                                       // full amount of memory used by this
+                                       // compact, including the portions not
+                                       // yet used
+    StgWord                autoBlockW; // size of automatically appended blocks
+    StgCompactNFDataBlock *nursery; // where to (try to) allocate from when
+                                    // appending
+    StgCompactNFDataBlock *last; // the last block of the chain (to know where
+                                 // to append new blocks for resize)
+} StgCompactNFData;
+
+
 #endif /* RTS_STORAGE_CLOSURES_H */
diff --git a/includes/rts/storage/GC.h b/includes/rts/storage/GC.h
index 4aa44bd344..50fc5eb227 100644
--- a/includes/rts/storage/GC.h
+++ b/includes/rts/storage/GC.h
@@ -94,6 +94,22 @@ typedef struct generation_ {
     memcount       n_new_large_words;   // words of new large objects
                                         // (for doYouWantToGC())
 
+    bdescr *       compact_objects;     // compact objects chain
+                                        // the second block in each compact is
+                                        // linked from the closure object, while
+                                        // the second compact object in the
+                                        // chain is linked from bd->link (like
+                                        // large objects)
+    memcount       n_compact_blocks;    // no. of blocks used by all compacts
+    bdescr *       compact_blocks_in_import; // compact objects being imported
+                                             // (not known to the GC because
+                                             // potentially invalid, but we
+                                             // need to keep track of them
+                                             // to avoid assertions in Sanity)
+                                             // this is a list shaped like compact_objects
+    memcount       n_compact_blocks_in_import; // no. of blocks used by compacts
+                                               // being imported
+
     memcount       max_blocks;          // max blocks
 
     StgTSO *       threads;             // threads in this gen
@@ -130,6 +146,9 @@ typedef struct generation_ {
     bdescr *     scavenged_large_objects;  // live large objs after GC (d-link)
     memcount     n_scavenged_large_blocks; // size (not count) of above
 
+    bdescr *     live_compact_objects;  // live compact objs after GC (d-link)
+    memcount     n_live_compact_blocks; // size (not count) of above
+
     bdescr *     bitmap;                // bitmap for compacting collection
 
     StgTSO *     old_threads;
diff --git a/includes/stg/MiscClosures.h b/includes/stg/MiscClosures.h
index 731893efd0..0b8fbdc78a 100644
--- a/includes/stg/MiscClosures.h
+++ b/includes/stg/MiscClosures.h
@@ -144,6 +144,7 @@ RTS_ENTRY(stg_END_STM_WATCH_QUEUE);
 RTS_ENTRY(stg_END_INVARIANT_CHECK_QUEUE);
 RTS_ENTRY(stg_END_STM_CHUNK_LIST);
 RTS_ENTRY(stg_NO_TREC);
+RTS_ENTRY(stg_COMPACT_NFDATA);
 
 /* closures */
 
@@ -403,6 +404,17 @@ RTS_FUN_DECL(stg_makeStableNamezh);
 RTS_FUN_DECL(stg_makeStablePtrzh);
 RTS_FUN_DECL(stg_deRefStablePtrzh);
 
+RTS_FUN_DECL(stg_compactNewzh);
+RTS_FUN_DECL(stg_compactAppendzh);
+RTS_FUN_DECL(stg_compactResizzezh);
+RTS_FUN_DECL(stg_compactGetRootzh);
+RTS_FUN_DECL(stg_compactContainszh);
+RTS_FUN_DECL(stg_compactContainsAnyzh);
+RTS_FUN_DECL(stg_compactGetFirstBlockzh);
+RTS_FUN_DECL(stg_compactGetNextBlockzh);
+RTS_FUN_DECL(stg_compactAllocateBlockzh);
+RTS_FUN_DECL(stg_compactFixupPointerszh);
+
 RTS_FUN_DECL(stg_forkzh);
 RTS_FUN_DECL(stg_forkOnzh);
 RTS_FUN_DECL(stg_yieldzh);