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 /libraries/ghc-heap | |
| parent | 08b4c81363f405bf67ff85c5d132ff5919515095 (diff) | |
| download | haskell-284cca51f07c70c03ce602c963e22acf7333180b.tar.gz | |
support small arrays and CONSTR_NOCAF in ghc-heap
Diffstat (limited to 'libraries/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 |
2 files changed, 16 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 |