diff options
| author | David Hewson <david.hewson@tracsis.com> | 2019-05-03 22:18:10 +0100 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2019-05-31 01:58:47 -0400 |
| commit | 284cca51f07c70c03ce602c963e22acf7333180b (patch) | |
| tree | 4f7f1ac290eb056b8ad63dd97f75d49161f45732 | |
| parent | 08b4c81363f405bf67ff85c5d132ff5919515095 (diff) | |
| download | haskell-284cca51f07c70c03ce602c963e22acf7333180b.tar.gz | |
support small arrays and CONSTR_NOCAF in ghc-heap
| -rw-r--r-- | libraries/ghc-heap/GHC/Exts/Heap.hs | 6 | ||||
| -rw-r--r-- | libraries/ghc-heap/GHC/Exts/Heap/Closures.hs | 10 | ||||
| -rw-r--r-- | rts/Heap.c | 11 |
3 files changed, 27 insertions, 0 deletions
diff --git a/libraries/ghc-heap/GHC/Exts/Heap.hs b/libraries/ghc-heap/GHC/Exts/Heap.hs index 16b00e0dfb..d3b9097b2d 100644 --- a/libraries/ghc-heap/GHC/Exts/Heap.hs +++ b/libraries/ghc-heap/GHC/Exts/Heap.hs @@ -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) diff --git a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs index 38fef83940..025c30aaa1 100644 --- a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs +++ b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs @@ -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 diff --git a/rts/Heap.c b/rts/Heap.c index dfd32aff0c..f0cc3567d9 100644 --- a/rts/Heap.c +++ b/rts/Heap.c @@ -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; |