support small arrays and CONSTR_NOCAF in ghc-heap
authorDavid Hewson <david.hewson@tracsis.com>
Fri, 3 May 2019 21:18:10 +0000 (22:18 +0100)
committerMarge Bot <ben+marge-bot@smart-cactus.org>
Fri, 31 May 2019 05:58:47 +0000 (01:58 -0400)
libraries/ghc-heap/GHC/Exts/Heap.hs
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
rts/Heap.c

index 16b00e0..d3b9097 100644 (file)
@@ -248,6 +248,12 @@ getClosure x = do
                         ++ "found " ++ show (length rawWds)
             pure $ MutArrClosure itbl (rawWds !! 0) (rawWds !! 1) pts
 
+        t | t >= SMALL_MUT_ARR_PTRS_CLEAN && t <= SMALL_MUT_ARR_PTRS_FROZEN_CLEAN -> do
+            unless (length rawWds >= 1) $
+                fail $ "Expected at least 1 word to SMALL_MUT_ARR_PTRS_* "
+                        ++ "found " ++ show (length rawWds)
+            pure $ SmallMutArrClosure itbl (rawWds !! 0) pts
+
         t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY ->
             pure $ MutVarClosure itbl (head pts)
 
index 38fef83..025c30a 100644 (file)
@@ -221,6 +221,15 @@ data GenClosure b
         -- Card table ignored
         }
 
+    -- | A @SmallMutableArray#@
+    --
+    -- @since 8.10.1
+  | SmallMutArrClosure
+        { info       :: !StgInfoTable
+        , mccPtrs    :: !Word           -- ^ Number of pointers
+        , mccPayload :: ![b]            -- ^ Array payload
+        }
+
     -- | An @MVar#@, with a queue of thread state objects blocking on them
   | MVarClosure
         { info       :: !StgInfoTable
@@ -321,6 +330,7 @@ allClosures (APStackClosure {..}) = fun:payload
 allClosures (BCOClosure {..}) = [instrs,literals,bcoptrs]
 allClosures (ArrWordsClosure {}) = []
 allClosures (MutArrClosure {..}) = mccPayload
+allClosures (SmallMutArrClosure {..}) = mccPayload
 allClosures (MutVarClosure {..}) = [var]
 allClosures (MVarClosure {..}) = [queueHead,queueTail,value]
 allClosures (FunClosure {..}) = ptrArgs
index dfd32af..f0cc356 100644 (file)
@@ -110,6 +110,7 @@ StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
         case CONSTR_1_1:
         case CONSTR_0_2:
         case CONSTR:
+        case CONSTR_NOCAF:
 
 
         case PRIM:
@@ -192,6 +193,16 @@ StgMutArrPtrs *heap_view_closurePtrs(Capability *cap, StgClosure *closure) {
                 ptrs[nptrs++] = ((StgMutArrPtrs *)closure)->payload[i];
             }
             break;
+
+        case SMALL_MUT_ARR_PTRS_CLEAN:
+        case SMALL_MUT_ARR_PTRS_DIRTY:
+        case SMALL_MUT_ARR_PTRS_FROZEN_CLEAN:
+        case SMALL_MUT_ARR_PTRS_FROZEN_DIRTY:
+            for (i = 0; i < ((StgSmallMutArrPtrs *)closure)->ptrs; ++i) {
+                ptrs[nptrs++] = ((StgSmallMutArrPtrs *)closure)->payload[i];
+            }
+            break;
+
         case MUT_VAR_CLEAN:
         case MUT_VAR_DIRTY:
             ptrs[nptrs++] = ((StgMutVar *)closure)->var;