ghc-heap 9.0.1 → 9.2.1

raw patch · 11 files changed

+835/−81 lines, 11 filesdep +containersdep ~basedep ~ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: containers

Dependency ranges changed: base, ghc-prim

API changes (from Hackage documentation)

Files

• GHC/Exts/Heap.hs +178/−66
• GHC/Exts/Heap/Closures.hs +80/−12
• GHC/Exts/Heap/FFIClosures.hs +47/−0
• GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc +131/−0
• GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc +130/−0
• GHC/Exts/Heap/ProfInfo/PeekProfInfo.hs +13/−0
• GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingDisabled.hsc +16/−0
• GHC/Exts/Heap/ProfInfo/PeekProfInfo_ProfilingEnabled.hsc +173/−0
• GHC/Exts/Heap/ProfInfo/Types.hs +56/−0
• GHC/Exts/Heap/Utils.hsc +1/−1
• ghc-heap.cabal +10/−2

@@ -7,6 +7,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UnliftedFFITypes #-}  {-| Module      :  GHC.Exts.Heap@@ -24,7 +27,12 @@     , GenClosure(..)     , ClosureType(..)     , PrimType(..)+    , WhatNext(..)+    , WhyBlocked(..)+    , TsoFlags(..)     , HasHeapRep(getClosureData)+    , getClosureDataFromHeapRep+    , getClosureDataFromHeapRepPrim      -- * Info Table types     , StgInfoTable(..)@@ -35,6 +43,12 @@     , peekItbl     , pokeItbl +    -- * Cost Centre (profiling) types+    , StgTSOProfInfo(..)+    , IndexTable(..)+    , CostCentre(..)+    , CostCentreStack(..)+      -- * Closure inspection     , getBoxedClosureData     , allClosures@@ -49,16 +63,19 @@ import GHC.Exts.Heap.Closures import GHC.Exts.Heap.ClosureTypes import GHC.Exts.Heap.Constants+import GHC.Exts.Heap.ProfInfo.Types #if defined(PROFILING) import GHC.Exts.Heap.InfoTableProf #else import GHC.Exts.Heap.InfoTable #endif import GHC.Exts.Heap.Utils+import qualified GHC.Exts.Heap.FFIClosures as FFIClosures+import qualified GHC.Exts.Heap.ProfInfo.PeekProfInfo as PPI  import Control.Monad import Data.Bits-import GHC.Arr+import Foreign import GHC.Exts import GHC.Int import GHC.Word@@ -66,13 +83,27 @@ #include "ghcconfig.h"  class HasHeapRep (a :: TYPE rep) where-    getClosureData :: a -> IO Closure +    -- | Decode a closure to it's heap representation ('GenClosure').+    getClosureData+        :: a+        -- ^ Closure to decode.+        -> IO Closure+        -- ^ Heap representation of the closure.++#if __GLASGOW_HASKELL__ >= 901+instance HasHeapRep (a :: TYPE ('BoxedRep 'Lifted)) where+#else instance HasHeapRep (a :: TYPE 'LiftedRep) where-    getClosureData = getClosure+#endif+    getClosureData = getClosureDataFromHeapObject +#if __GLASGOW_HASKELL__ >= 901+instance HasHeapRep (a :: TYPE ('BoxedRep 'Unlifted)) where+#else instance HasHeapRep (a :: TYPE 'UnliftedRep) where-    getClosureData x = getClosure (unsafeCoerce# x)+#endif+    getClosureData x = getClosureDataFromHeapObject (unsafeCoerce# x)  instance Int# ~ a => HasHeapRep (a :: TYPE 'IntRep) where     getClosureData x = return $@@ -102,52 +133,92 @@     getClosureData x = return $         DoubleClosure { ptipe = PDouble, doubleVal = D# x } --- | This returns the raw representation of the given argument. The second--- component of the triple is the raw words of the closure on the heap, and the--- third component is those words that are actually pointers. Once back in the--- Haskell world, the raw words that hold pointers may be outdated after a--- garbage collector run, but the corresponding values in 'Box's will still--- point to the correct value.-getClosureRaw :: a -> IO (Ptr StgInfoTable, [Word], [Box])-getClosureRaw x = do+-- | Get the heap representation of a closure _at this moment_, even if it is+-- unevaluated or an indirection or other exotic stuff. Beware when passing+-- something to this function, the same caveats as for+-- 'GHC.Exts.Heap.Closures.asBox' apply.+--+-- For most use cases 'getClosureData' is an easier to use alternative.+--+-- Currently TSO and STACK objects will return `UnsupportedClosure`. This is+-- because it is not memory safe to extract TSO and STACK objects (done via+-- `unpackClosure#`). Other threads may be mutating those objects and interleave+-- with reads in `unpackClosure#`. This is particularly problematic with STACKs+-- where pointer values may be overwritten by non-pointer values as the+-- corresponding haskell thread runs.+getClosureDataFromHeapObject+    :: a+    -- ^ Heap object to decode.+    -> IO Closure+    -- ^ Heap representation of the closure.+getClosureDataFromHeapObject x = do     case unpackClosure# x of--- This is a hack to cover the bootstrap compiler using the old version of--- 'unpackClosure'. The new 'unpackClosure' return values are not merely--- a reordering, so using the old version would not work.-        (# iptr, dat, pointers #) -> do-            let nelems = (I# (sizeofByteArray# dat)) `div` wORD_SIZE-                end = fromIntegral nelems - 1-                rawWds = [W# (indexWordArray# dat i) | I# i <- [0.. end] ]-                pelems = I# (sizeofArray# pointers)-                ptrList = amap' Box $ Array 0 (pelems - 1) pelems pointers-            pure (Ptr iptr, rawWds, ptrList)+        (# infoTableAddr, heapRep, pointersArray #) -> do+            let infoTablePtr = Ptr infoTableAddr+                ptrList = [case indexArray# pointersArray i of+                                (# ptr #) -> Box ptr+                            | I# i <- [0..(I# (sizeofArray# pointersArray)) - 1]+                            ] --- From GHC.Runtime.Heap.Inspect-amap' :: (t -> b) -> Array Int t -> [b]-amap' f (Array i0 i _ arr#) = map g [0 .. i - i0]-    where g (I# i#) = case indexArray# arr# i# of-                          (# e #) -> f e+            infoTable <- peekItbl infoTablePtr+            case tipe infoTable of+                TSO   -> pure $ UnsupportedClosure infoTable+                STACK -> pure $ UnsupportedClosure infoTable+                _ -> getClosureDataFromHeapRep heapRep infoTablePtr ptrList --- | This function returns a parsed heap representation of the argument _at--- this moment_, even if it is unevaluated or an indirection or other exotic--- stuff.  Beware when passing something to this function, the same caveats as--- for 'asBox' apply.-getClosure :: a -> IO Closure-getClosure x = do-    (iptr, wds, pts) <- getClosureRaw x-    itbl <- peekItbl iptr-    -- The remaining words after the header-    let rawWds = drop (closureTypeHeaderSize (tipe itbl)) wds-    -- For data args in a pointers then non-pointers closure-    -- This is incorrect in non pointers-first setups-    -- not sure if that happens-        npts = drop (closureTypeHeaderSize (tipe itbl) + length pts) wds++-- | Convert an unpacked heap object, to a `GenClosure b`. The inputs to this+-- function can be generated from a heap object using `unpackClosure#`.+getClosureDataFromHeapRep :: ByteArray# -> Ptr StgInfoTable -> [b] -> IO (GenClosure b)+getClosureDataFromHeapRep heapRep infoTablePtr pts = do+  itbl <- peekItbl infoTablePtr+  getClosureDataFromHeapRepPrim (dataConNames infoTablePtr) PPI.peekTopCCS itbl heapRep pts++getClosureDataFromHeapRepPrim+    :: IO (String, String, String)+    -- ^ A continuation used to decode the constructor description field,+    -- in ghc-debug this code can lead to segfaults because dataConNames+    -- will dereference a random part of memory.+    -> (Ptr a -> IO (Maybe CostCentreStack))+    -- ^ A continuation which is used to decode a cost centre stack+    -- In ghc-debug, this code will need to call back into the debuggee to+    -- fetch the representation of the CCS before decoding it. Using+    -- `peekTopCCS` for this argument can lead to segfaults in ghc-debug as+    -- the CCS argument will point outside the copied closure.+    -> StgInfoTable+    -- ^ The `StgInfoTable` of the closure, extracted from the heap+    -- representation.+    -> ByteArray#+    -- ^ Heap representation of the closure as returned by `unpackClosure#`.+    -- This includes all of the object including the header, info table+    -- pointer, pointer data, and non-pointer data. The ByteArray# may be+    -- pinned or unpinned.+    -> [b]+    -- ^ Pointers in the payload of the closure, extracted from the heap+    -- representation as returned by `collect_pointers()` in `Heap.c`. The type+    -- `b` is some representation of a pointer e.g. `Any` or `Ptr Any`.+    -> IO (GenClosure b)+    -- ^ Heap representation of the closure.+getClosureDataFromHeapRepPrim getConDesc decodeCCS itbl heapRep pts = do+    let -- heapRep as a list of words.+        rawHeapWords :: [Word]+        rawHeapWords = [W# (indexWordArray# heapRep i) | I# i <- [0.. end] ]+            where+            nelems = (I# (sizeofByteArray# heapRep)) `div` wORD_SIZE+            end = fromIntegral nelems - 1++        -- Just the payload of rawHeapWords (no header).+        payloadWords :: [Word]+        payloadWords = drop (closureTypeHeaderSize (tipe itbl)) rawHeapWords++        -- The non-pointer words in the payload. Only valid for closures with a+        -- "pointers first" layout. Not valid for bit field layout.+        npts :: [Word]+        npts = drop (closureTypeHeaderSize (tipe itbl) + length pts) rawHeapWords     case tipe itbl of         t | t >= CONSTR && t <= CONSTR_NOCAF -> do-            (p, m, n) <- dataConNames iptr-            if m == "GHC.ByteCode.Instr" && n == "BreakInfo"-              then pure $ UnsupportedClosure itbl-              else pure $ ConstrClosure itbl pts npts p m n+            (p, m, n) <- getConDesc+            pure $ ConstrClosure itbl pts npts p m n          t | t >= THUNK && t <= THUNK_STATIC -> do             pure $ ThunkClosure itbl pts npts@@ -164,9 +235,9 @@             unless (length pts >= 1) $                 fail "Expected at least 1 ptr argument to AP"             -- We expect at least the arity, n_args, and fun fields-            unless (length rawWds >= 2) $+            unless (length payloadWords >= 2) $                 fail $ "Expected at least 2 raw words to AP"-            let splitWord = rawWds !! 0+            let splitWord = payloadWords !! 0             pure $ APClosure itbl #if defined(WORDS_BIGENDIAN)                 (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))@@ -181,9 +252,9 @@             unless (length pts >= 1) $                 fail "Expected at least 1 ptr argument to PAP"             -- We expect at least the arity, n_args, and fun fields-            unless (length rawWds >= 2) $+            unless (length payloadWords >= 2) $                 fail "Expected at least 2 raw words to PAP"-            let splitWord = rawWds !! 0+            let splitWord = payloadWords !! 0             pure $ PAPClosure itbl #if defined(WORDS_BIGENDIAN)                 (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))@@ -218,10 +289,10 @@             unless (length pts >= 3) $                 fail $ "Expected at least 3 ptr argument to BCO, found "                         ++ show (length pts)-            unless (length rawWds >= 4) $+            unless (length payloadWords >= 4) $                 fail $ "Expected at least 4 words to BCO, found "-                        ++ show (length rawWds)-            let splitWord = rawWds !! 3+                        ++ show (length payloadWords)+            let splitWord = payloadWords !! 3             pure $ BCOClosure itbl (pts !! 0) (pts !! 1) (pts !! 2) #if defined(WORDS_BIGENDIAN)                 (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))@@ -230,27 +301,30 @@                 (fromIntegral splitWord)                 (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2)) #endif-                (drop 4 rawWds)+                (drop 4 payloadWords)          ARR_WORDS -> do-            unless (length rawWds >= 1) $+            unless (length payloadWords >= 1) $                 fail $ "Expected at least 1 words to ARR_WORDS, found "-                        ++ show (length rawWds)-            pure $ ArrWordsClosure itbl (head rawWds) (tail rawWds)+                        ++ show (length payloadWords)+            pure $ ArrWordsClosure itbl (head payloadWords) (tail payloadWords)          t | t >= MUT_ARR_PTRS_CLEAN && t <= MUT_ARR_PTRS_FROZEN_CLEAN -> do-            unless (length rawWds >= 2) $+            unless (length payloadWords >= 2) $                 fail $ "Expected at least 2 words to MUT_ARR_PTRS_* "-                        ++ "found " ++ show (length rawWds)-            pure $ MutArrClosure itbl (rawWds !! 0) (rawWds !! 1) pts+                        ++ "found " ++ show (length payloadWords)+            pure $ MutArrClosure itbl (payloadWords !! 0) (payloadWords !! 1) pts          t | t >= SMALL_MUT_ARR_PTRS_CLEAN && t <= SMALL_MUT_ARR_PTRS_FROZEN_CLEAN -> do-            unless (length rawWds >= 1) $+            unless (length payloadWords >= 1) $                 fail $ "Expected at least 1 word to SMALL_MUT_ARR_PTRS_* "-                        ++ "found " ++ show (length rawWds)-            pure $ SmallMutArrClosure itbl (rawWds !! 0) pts+                        ++ "found " ++ show (length payloadWords)+            pure $ SmallMutArrClosure itbl (payloadWords !! 0) pts -        t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY ->+        t | t == MUT_VAR_CLEAN || t == MUT_VAR_DIRTY -> do+            unless (length pts >= 1) $+                fail $ "Expected at least 1 words to MUT_VAR, found "+                        ++ show (length pts)             pure $ MutVarClosure itbl (head pts)          t | t == MVAR_CLEAN || t == MVAR_DIRTY -> do@@ -260,13 +334,12 @@             pure $ MVarClosure itbl (pts !! 0) (pts !! 1) (pts !! 2)          BLOCKING_QUEUE ->-            pure $ OtherClosure itbl pts wds+            pure $ OtherClosure itbl pts rawHeapWords         --    pure $ BlockingQueueClosure itbl         --        (pts !! 0) (pts !! 1) (pts !! 2) (pts !! 3) -        --  pure $ OtherClosure itbl pts wds+        --  pure $ OtherClosure itbl pts rawHeapWords         ---         WEAK ->             pure $ WeakClosure                 { info = itbl@@ -276,6 +349,45 @@                 , finalizer = pts !! 3                 , link = pts !! 4                 }+        TSO | [ u_lnk, u_gbl_lnk, tso_stack, u_trec, u_blk_ex, u_bq] <- pts+                -> withArray rawHeapWords (\ptr -> do+                    fields <- FFIClosures.peekTSOFields decodeCCS ptr+                    pure $ TSOClosure+                        { info = itbl+                        , link = u_lnk+                        , global_link = u_gbl_lnk+                        , tsoStack = tso_stack+                        , trec = u_trec+                        , blocked_exceptions = u_blk_ex+                        , bq = u_bq+                        , what_next = FFIClosures.tso_what_next fields+                        , why_blocked = FFIClosures.tso_why_blocked fields+                        , flags = FFIClosures.tso_flags fields+                        , threadId = FFIClosures.tso_threadId fields+                        , saved_errno = FFIClosures.tso_saved_errno fields+                        , tso_dirty = FFIClosures.tso_dirty fields+                        , alloc_limit = FFIClosures.tso_alloc_limit fields+                        , tot_stack_size = FFIClosures.tso_tot_stack_size fields+                        , prof = FFIClosures.tso_prof fields+                        })+            | otherwise+                -> fail $ "Expected 6 ptr arguments to TSO, found "+                        ++ show (length pts)+        STACK+            | [] <- pts+            -> withArray rawHeapWords (\ptr -> do+                            fields <- FFIClosures.peekStackFields ptr+                            pure $ StackClosure+                                { info = itbl+                                , stack_size = FFIClosures.stack_size fields+                                , stack_dirty = FFIClosures.stack_dirty fields+#if __GLASGOW_HASKELL__ >= 811+                                , stack_marking = FFIClosures.stack_marking fields+#endif+                                })+            | otherwise+                -> fail $ "Expected 0 ptr argument to STACK, found "+                    ++ show (length pts)          _ ->             pure $ UnsupportedClosure itbl

@@ -12,13 +12,11 @@       Closure     , GenClosure(..)     , PrimType(..)+    , WhatNext(..)+    , WhyBlocked(..)+    , TsoFlags(..)     , allClosures-#if __GLASGOW_HASKELL__ >= 809-    -- The closureSize# primop is unsupported on earlier GHC releases but we-    -- build ghc-heap as a boot library so it must be buildable. Drop this once-    -- we are guaranteed to bootstsrap with GHC >= 8.9.     , closureSize-#endif      -- * Boxes     , Box(..)@@ -40,6 +38,8 @@ import GHC.Exts.Heap.InfoTableProf () #endif +import GHC.Exts.Heap.ProfInfo.Types+ import Data.Bits import Data.Int import Data.Word@@ -100,11 +100,11 @@ -- | This is the representation of a Haskell value on the heap. It reflects -- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/Closures.h> ----- The data type is parametrized by the type to store references in. Usually--- this is a 'Box' with the type synonym 'Closure'.+-- The data type is parametrized by `b`: the type to store references in.+-- Usually this is a 'Box' with the type synonym 'Closure'. ----- All Heap objects have the same basic layout. A header containing a pointer--- to the info table and a payload with various fields. The @info@ field below+-- All Heap objects have the same basic layout. A header containing a pointer to+-- the info table and a payload with various fields. The @info@ field below -- always refers to the info table pointed to by the header. The remaining -- fields are the payload. --@@ -268,6 +268,39 @@         , link        :: !b -- ^ next weak pointer for the capability, can be NULL.         } +  -- | Representation of StgTSO: A Thread State Object. The values for+  -- 'what_next', 'why_blocked' and 'flags' are defined in @Constants.h@.+  | TSOClosure+      { info                :: !StgInfoTable+      -- pointers+      , link                :: !b+      , global_link         :: !b+      , tsoStack            :: !b -- ^ stackobj from StgTSO+      , trec                :: !b+      , blocked_exceptions  :: !b+      , bq                  :: !b+      -- values+      , what_next           :: !WhatNext+      , why_blocked         :: !WhyBlocked+      , flags               :: ![TsoFlags]+      , threadId            :: !Word64+      , saved_errno         :: !Word32+      , tso_dirty           :: !Word32 -- ^ non-zero => dirty+      , alloc_limit         :: !Int64+      , tot_stack_size      :: !Word32+      , prof                :: !(Maybe StgTSOProfInfo)+      }++  -- | Representation of StgStack: The 'tsoStack ' of a 'TSOClosure'.+  | StackClosure+      { info            :: !StgInfoTable+      , stack_size      :: !Word32 -- ^ stack size in *words*+      , stack_dirty     :: !Word8 -- ^ non-zero => dirty+#if __GLASGOW_HASKELL__ >= 811+      , stack_marking   :: !Word8+#endif+      }+     ------------------------------------------------------------     -- Unboxed unlifted closures @@ -330,8 +363,45 @@   | PAddr   | PFloat   | PDouble-  deriving (Eq, Show, Generic)+  deriving (Eq, Show, Generic, Ord) +data WhatNext+  = ThreadRunGHC+  | ThreadInterpret+  | ThreadKilled+  | ThreadComplete+  | WhatNextUnknownValue Word16 -- ^ Please report this as a bug+  deriving (Eq, Show, Generic, Ord)++data WhyBlocked+  = NotBlocked+  | BlockedOnMVar+  | BlockedOnMVarRead+  | BlockedOnBlackHole+  | BlockedOnRead+  | BlockedOnWrite+  | BlockedOnDelay+  | BlockedOnSTM+  | BlockedOnDoProc+  | BlockedOnCCall+  | BlockedOnCCall_Interruptible+  | BlockedOnMsgThrowTo+  | ThreadMigrating+  | BlockedOnIOCompletion+  | WhyBlockedUnknownValue Word16 -- ^ Please report this as a bug+  deriving (Eq, Show, Generic, Ord)++data TsoFlags+  = TsoLocked+  | TsoBlockx+  | TsoInterruptible+  | TsoStoppedOnBreakpoint+  | TsoMarked+  | TsoSqueezed+  | TsoAllocLimit+  | TsoFlagsUnknownValue Word32 -- ^ Please report this as a bug+  deriving (Eq, Show, Generic, Ord)+ -- | For generic code, this function returns all referenced closures. allClosures :: GenClosure b -> [b] allClosures (ConstrClosure {..}) = ptrArgs@@ -355,11 +425,9 @@ allClosures (OtherClosure {..}) = hvalues allClosures _ = [] -#if __GLASGOW_HASKELL__ >= 809 -- | Get the size of the top-level closure in words. -- Includes header and payload. Does not follow pointers. -- -- @since 8.10.1 closureSize :: Box -> Int closureSize (Box x) = I# (closureSize# x)-#endif

@@ -0,0 +1,47 @@+{-# LANGUAGE CPP #-}++module GHC.Exts.Heap.FFIClosures (module Reexport) where++-- NOTE [hsc and CPP workaround]+--+-- # Problem+--+-- Often, .hsc files are used to get the correct offsets of C struct fields.+-- Those structs may be affected by CPP directives e.g. profiled vs not profiled+-- closure headers is affected by the PROFILED cpp define. Since we are building+-- multiple variants of the RTS, we must support all possible offsets e.g. by+-- running hsc2hs with cpp defines corresponding to each RTS flavour. The+-- problem is that GHC's build system runs hsc2hs *only once* per .hsc file+-- without properly setting cpp defines. This results in the same (probably+-- incorrect) offsets into our C structs.+--+--+-- # Workaround+--+-- To work around this issue, we create multiple .hsc files each manually+-- defining thir cpp defines (see e.g. FFIClosures_ProfilingDisabled.hsc and+-- FFIClosures_ProfilingEnabled.hsc). Then we rely on cpp defines working+-- correctly in .hs files and use CPP to switch on which .hsc module to+-- re-export (see below). In each case we import the desired .hsc module as+-- `Reexport` and we import `()` (i.e. nothing) from all other .hsc variants+-- just so that the build system sees all .hsc file as dependencies.+--+--+-- # Future Work+--+-- * Duplication of the code in the .hsc files could be reduced simply by+--   placing the code in a single .hsc.in file and `#include`ing it from each+--   .hsc file. The .hsc files would only be responsible for setting the correct+--   cpp defines. This currently doesn't work as hadrian doesn't know to copy+--   the .hsc.in file to the build directory.+-- * The correct solution would be for the build system to run `hsc2hs` with the+--   correct cpp defines once per RTS flavour.+--++#if defined(PROFILING)+import GHC.Exts.Heap.FFIClosures_ProfilingEnabled as Reexport+import GHC.Exts.Heap.FFIClosures_ProfilingDisabled ()+#else+import GHC.Exts.Heap.FFIClosures_ProfilingDisabled as Reexport+import GHC.Exts.Heap.FFIClosures_ProfilingEnabled ()+#endif

@@ -0,0 +1,131 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}++module GHC.Exts.Heap.FFIClosures_ProfilingDisabled where++-- See [hsc and CPP workaround]++#undef PROFILING+#include "Rts.h"++import Prelude+import Foreign+import GHC.Exts+import GHC.Exts.Heap.ProfInfo.PeekProfInfo+import GHC.Exts.Heap.ProfInfo.Types+import GHC.Exts.Heap.Closures(WhatNext(..), WhyBlocked(..), TsoFlags(..))++data TSOFields = TSOFields {+    tso_what_next :: WhatNext,+    tso_why_blocked :: WhyBlocked,+    tso_flags :: [TsoFlags],+-- Unfortunately block_info is a union without clear discriminator.+--    block_info :: TDB,+    tso_threadId :: Word64,+    tso_saved_errno :: Word32,+    tso_dirty:: Word32,+    tso_alloc_limit :: Int64,+    tso_tot_stack_size :: Word32,+    tso_prof :: Maybe StgTSOProfInfo+}++-- | Get non-pointer fields from @StgTSO_@ (@TSO.h@)+peekTSOFields :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO TSOFields+peekTSOFields decodeCCS ptr = do+    what_next' <- (#peek struct StgTSO_, what_next) ptr+    why_blocked' <- (#peek struct StgTSO_, why_blocked) ptr+    flags' <- (#peek struct StgTSO_, flags) ptr+    threadId' <- (#peek struct StgTSO_, id) ptr+    saved_errno' <- (#peek struct StgTSO_, saved_errno) ptr+    dirty' <- (#peek struct StgTSO_, dirty) ptr+    alloc_limit' <- (#peek struct StgTSO_, alloc_limit) ptr+    tot_stack_size' <- (#peek struct StgTSO_, tot_stack_size) ptr+    tso_prof' <- peekStgTSOProfInfo decodeCCS ptr++    return TSOFields {+        tso_what_next = parseWhatNext what_next',+        tso_why_blocked = parseWhyBlocked why_blocked',+        tso_flags = parseTsoFlags flags',+        tso_threadId = threadId',+        tso_saved_errno = saved_errno',+        tso_dirty = dirty',+        tso_alloc_limit = alloc_limit',+        tso_tot_stack_size = tot_stack_size',+        tso_prof = tso_prof'+    }++parseWhatNext :: Word16 -> WhatNext+parseWhatNext w = case w of+                    (#const ThreadRunGHC) -> ThreadRunGHC+                    (#const ThreadInterpret) -> ThreadInterpret+                    (#const ThreadKilled) -> ThreadKilled+                    (#const ThreadComplete) -> ThreadComplete+                    _ -> WhatNextUnknownValue w++parseWhyBlocked :: Word16 -> WhyBlocked+parseWhyBlocked w = case w of+                        (#const NotBlocked) -> NotBlocked+                        (#const BlockedOnMVar) -> BlockedOnMVar+                        (#const BlockedOnMVarRead) -> BlockedOnMVarRead+                        (#const BlockedOnBlackHole) -> BlockedOnBlackHole+                        (#const BlockedOnRead) -> BlockedOnRead+                        (#const BlockedOnWrite) -> BlockedOnWrite+                        (#const BlockedOnDelay) -> BlockedOnDelay+                        (#const BlockedOnSTM) -> BlockedOnSTM+                        (#const BlockedOnDoProc) -> BlockedOnDoProc+                        (#const BlockedOnCCall) -> BlockedOnCCall+                        (#const BlockedOnCCall_Interruptible) -> BlockedOnCCall_Interruptible+                        (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo+                        (#const ThreadMigrating) -> ThreadMigrating+#if __GLASGOW_HASKELL__ >= 811+                        (#const BlockedOnIOCompletion) -> BlockedOnIOCompletion+#endif+                        _ -> WhyBlockedUnknownValue w++parseTsoFlags :: Word32 -> [TsoFlags]+parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset (#const TSO_LOCKED) w)+                | isSet (#const TSO_BLOCKEX) w = TsoBlockx : parseTsoFlags (unset (#const TSO_BLOCKEX) w)+                | isSet (#const TSO_INTERRUPTIBLE) w = TsoInterruptible : parseTsoFlags (unset (#const TSO_INTERRUPTIBLE) w)+                | isSet (#const TSO_STOPPED_ON_BREAKPOINT) w = TsoStoppedOnBreakpoint : parseTsoFlags (unset (#const TSO_STOPPED_ON_BREAKPOINT) w)+                | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)+                | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)+                | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)+parseTsoFlags 0 = []+parseTsoFlags w = [TsoFlagsUnknownValue w]++isSet :: Word32 -> Word32 -> Bool+isSet bitMask w = w .&. bitMask /= 0++unset :: Word32 -> Word32 -> Word32+unset bitMask w = w `xor` bitMask++data StackFields = StackFields {+    stack_size :: Word32,+    stack_dirty :: Word8,+#if __GLASGOW_HASKELL__ >= 811+    stack_marking :: Word8,+#endif+    stack_sp :: Addr##+}++-- | Get non-closure fields from @StgStack_@ (@TSO.h@)+peekStackFields :: Ptr a -> IO StackFields+peekStackFields ptr = do+    stack_size' <- (#peek struct StgStack_, stack_size) ptr ::IO Word32+    dirty' <- (#peek struct StgStack_, dirty) ptr+#if __GLASGOW_HASKELL__ >= 811+    marking' <- (#peek struct StgStack_, marking) ptr+#endif+    Ptr sp' <- (#peek struct StgStack_, sp) ptr++    -- TODO decode the stack.++    return StackFields {+        stack_size = stack_size',+        stack_dirty = dirty',+#if __GLASGOW_HASKELL__ >= 811+        stack_marking = marking',+#endif+        stack_sp = sp'+    }+

@@ -0,0 +1,130 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}++module GHC.Exts.Heap.FFIClosures_ProfilingEnabled where++-- See [hsc and CPP workaround]++#define PROFILING+#include "Rts.h"++import Prelude+import Foreign+import GHC.Exts+import GHC.Exts.Heap.ProfInfo.PeekProfInfo+import GHC.Exts.Heap.ProfInfo.Types+import GHC.Exts.Heap.Closures(WhatNext(..), WhyBlocked(..), TsoFlags(..))++data TSOFields = TSOFields {+    tso_what_next :: WhatNext,+    tso_why_blocked :: WhyBlocked,+    tso_flags :: [TsoFlags],+-- Unfortunately block_info is a union without clear discriminator.+--    block_info :: TDB,+    tso_threadId :: Word64,+    tso_saved_errno :: Word32,+    tso_dirty:: Word32,+    tso_alloc_limit :: Int64,+    tso_tot_stack_size :: Word32,+    tso_prof :: Maybe StgTSOProfInfo+}++-- | Get non-pointer fields from @StgTSO_@ (@TSO.h@)+peekTSOFields :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO TSOFields+peekTSOFields decodeCCS ptr = do+    what_next' <- (#peek struct StgTSO_, what_next) ptr+    why_blocked' <- (#peek struct StgTSO_, why_blocked) ptr+    flags' <- (#peek struct StgTSO_, flags) ptr+    threadId' <- (#peek struct StgTSO_, id) ptr+    saved_errno' <- (#peek struct StgTSO_, saved_errno) ptr+    dirty' <- (#peek struct StgTSO_, dirty) ptr+    alloc_limit' <- (#peek struct StgTSO_, alloc_limit) ptr+    tot_stack_size' <- (#peek struct StgTSO_, tot_stack_size) ptr+    tso_prof' <- peekStgTSOProfInfo decodeCCS ptr++    return TSOFields {+        tso_what_next = parseWhatNext what_next',+        tso_why_blocked = parseWhyBlocked why_blocked',+        tso_flags = parseTsoFlags flags',+        tso_threadId = threadId',+        tso_saved_errno = saved_errno',+        tso_dirty = dirty',+        tso_alloc_limit = alloc_limit',+        tso_tot_stack_size = tot_stack_size',+        tso_prof = tso_prof'+    }++parseWhatNext :: Word16 -> WhatNext+parseWhatNext w = case w of+                    (#const ThreadRunGHC) -> ThreadRunGHC+                    (#const ThreadInterpret) -> ThreadInterpret+                    (#const ThreadKilled) -> ThreadKilled+                    (#const ThreadComplete) -> ThreadComplete+                    _ -> WhatNextUnknownValue w++parseWhyBlocked :: Word16 -> WhyBlocked+parseWhyBlocked w = case w of+                        (#const NotBlocked) -> NotBlocked+                        (#const BlockedOnMVar) -> BlockedOnMVar+                        (#const BlockedOnMVarRead) -> BlockedOnMVarRead+                        (#const BlockedOnBlackHole) -> BlockedOnBlackHole+                        (#const BlockedOnRead) -> BlockedOnRead+                        (#const BlockedOnWrite) -> BlockedOnWrite+                        (#const BlockedOnDelay) -> BlockedOnDelay+                        (#const BlockedOnSTM) -> BlockedOnSTM+                        (#const BlockedOnDoProc) -> BlockedOnDoProc+                        (#const BlockedOnCCall) -> BlockedOnCCall+                        (#const BlockedOnCCall_Interruptible) -> BlockedOnCCall_Interruptible+                        (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo+                        (#const ThreadMigrating) -> ThreadMigrating+#if __GLASGOW_HASKELL__ >= 811+                        (#const BlockedOnIOCompletion) -> BlockedOnIOCompletion+#endif+                        _ -> WhyBlockedUnknownValue w++parseTsoFlags :: Word32 -> [TsoFlags]+parseTsoFlags w | isSet (#const TSO_LOCKED) w = TsoLocked : parseTsoFlags (unset (#const TSO_LOCKED) w)+                | isSet (#const TSO_BLOCKEX) w = TsoBlockx : parseTsoFlags (unset (#const TSO_BLOCKEX) w)+                | isSet (#const TSO_INTERRUPTIBLE) w = TsoInterruptible : parseTsoFlags (unset (#const TSO_INTERRUPTIBLE) w)+                | isSet (#const TSO_STOPPED_ON_BREAKPOINT) w = TsoStoppedOnBreakpoint : parseTsoFlags (unset (#const TSO_STOPPED_ON_BREAKPOINT) w)+                | isSet (#const TSO_MARKED) w = TsoMarked : parseTsoFlags (unset (#const TSO_MARKED) w)+                | isSet (#const TSO_SQUEEZED) w = TsoSqueezed : parseTsoFlags (unset (#const TSO_SQUEEZED) w)+                | isSet (#const TSO_ALLOC_LIMIT) w = TsoAllocLimit : parseTsoFlags (unset (#const TSO_ALLOC_LIMIT) w)+parseTsoFlags 0 = []+parseTsoFlags w = [TsoFlagsUnknownValue w]++isSet :: Word32 -> Word32 -> Bool+isSet bitMask w = w .&. bitMask /= 0++unset :: Word32 -> Word32 -> Word32+unset bitMask w = w `xor` bitMask++data StackFields = StackFields {+    stack_size :: Word32,+    stack_dirty :: Word8,+#if __GLASGOW_HASKELL__ >= 811+    stack_marking :: Word8,+#endif+    stack_sp :: Addr##+}++-- | Get non-closure fields from @StgStack_@ (@TSO.h@)+peekStackFields :: Ptr a -> IO StackFields+peekStackFields ptr = do+    stack_size' <- (#peek struct StgStack_, stack_size) ptr ::IO Word32+    dirty' <- (#peek struct StgStack_, dirty) ptr+#if __GLASGOW_HASKELL__ >= 811+    marking' <- (#peek struct StgStack_, marking) ptr+#endif+    Ptr sp' <- (#peek struct StgStack_, sp) ptr++    -- TODO decode the stack.++    return StackFields {+        stack_size = stack_size',+        stack_dirty = dirty',+#if __GLASGOW_HASKELL__ >= 811+        stack_marking = marking',+#endif+        stack_sp = sp'+    }

@@ -0,0 +1,13 @@+{-# LANGUAGE CPP #-}++module GHC.Exts.Heap.ProfInfo.PeekProfInfo (module Reexport) where++-- See [hsc and CPP workaround]++#if defined(PROFILING)+import GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled as Reexport+import GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled ()+#else+import GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled as Reexport+import GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled ()+#endif

@@ -0,0 +1,16 @@+module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled(+    peekStgTSOProfInfo+  , peekTopCCS+) where++import Prelude+import Foreign+import GHC.Exts.Heap.ProfInfo.Types++-- | This implementation is used when PROFILING is undefined.+-- It always returns 'Nothing', because there is no profiling info available.+peekStgTSOProfInfo :: (Ptr a -> IO (Maybe CostCentreStack)) -> Ptr tsoPtr -> IO (Maybe StgTSOProfInfo)+peekStgTSOProfInfo _ _ = return Nothing++peekTopCCS :: Ptr a -> IO (Maybe CostCentreStack)+peekTopCCS _ = return Nothing

@@ -0,0 +1,173 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE MagicHash #-}++module GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled(+    peekStgTSOProfInfo+    , peekTopCCS+) where++#if __GLASGOW_HASKELL__ >= 811++-- See [hsc and CPP workaround]++#define PROFILING++#include "Rts.h"+#undef BLOCK_SIZE+#undef MBLOCK_SIZE+#undef BLOCKS_PER_MBLOCK+#include "DerivedConstants.h"++import           Data.IntSet (IntSet)+import qualified Data.IntSet as IntSet+import           Data.IntMap.Strict (IntMap)+import qualified Data.IntMap.Strict as IntMap+import           Data.IORef (IORef, newIORef, readIORef, writeIORef)+import           Foreign+import           Foreign.C.String+import           GHC.Exts+import           GHC.Exts.Heap.ProfInfo.Types+import           Prelude++-- Use Int based containers for pointers (addresses) for better performance.+-- These will be queried a lot!+type AddressSet = IntSet+type AddressMap = IntMap++peekStgTSOProfInfo :: (Ptr b -> IO (Maybe CostCentreStack)) -> Ptr a -> IO (Maybe StgTSOProfInfo)+peekStgTSOProfInfo decodeCCS tsoPtr = do+    cccs_ptr <- peekByteOff tsoPtr cccsOffset+    cccs' <- decodeCCS cccs_ptr++    return $ Just StgTSOProfInfo {+        cccs = cccs'+    }++peekTopCCS :: Ptr b -> IO (Maybe CostCentreStack)+peekTopCCS cccs_ptr = do+  costCenterCacheRef <- newIORef IntMap.empty+  peekCostCentreStack IntSet.empty costCenterCacheRef cccs_ptr++cccsOffset :: Int+cccsOffset = (#const OFFSET_StgTSO_cccs) + (#size StgHeader)++peekCostCentreStack+    :: AddressSet+    -> IORef (AddressMap CostCentre)+    -> Ptr costCentreStack+    -> IO (Maybe CostCentreStack)+peekCostCentreStack _ _ ptr | ptr == nullPtr = return Nothing+peekCostCentreStack loopBreakers _ ptr | IntSet.member (ptrToInt ptr) loopBreakers = return Nothing+peekCostCentreStack loopBreakers costCenterCacheRef ptr = do+        ccs_ccsID' <- (#peek struct CostCentreStack_, ccsID) ptr+        ccs_cc_ptr <- (#peek struct CostCentreStack_, cc) ptr+        ccs_cc' <- peekCostCentre costCenterCacheRef ccs_cc_ptr+        ccs_prevStack_ptr <- (#peek struct CostCentreStack_, prevStack) ptr+        let loopBreakers' = (IntSet.insert ptrAsInt loopBreakers)+        ccs_prevStack' <- peekCostCentreStack loopBreakers' costCenterCacheRef ccs_prevStack_ptr+        ccs_indexTable_ptr <- (#peek struct CostCentreStack_, indexTable) ptr+        ccs_indexTable' <- peekIndexTable loopBreakers' costCenterCacheRef ccs_indexTable_ptr+        ccs_root_ptr <- (#peek struct CostCentreStack_, root) ptr+        ccs_root' <- peekCostCentreStack loopBreakers' costCenterCacheRef ccs_root_ptr+        ccs_depth' <- (#peek struct CostCentreStack_, depth) ptr+        ccs_scc_count' <- (#peek struct CostCentreStack_, scc_count) ptr+        ccs_selected' <- (#peek struct CostCentreStack_, selected) ptr+        ccs_time_ticks' <- (#peek struct CostCentreStack_, time_ticks) ptr+        ccs_mem_alloc' <- (#peek struct CostCentreStack_, mem_alloc) ptr+        ccs_inherited_alloc' <- (#peek struct CostCentreStack_, inherited_alloc) ptr+        ccs_inherited_ticks' <- (#peek struct CostCentreStack_, inherited_ticks) ptr++        return $ Just CostCentreStack {+            ccs_ccsID = ccs_ccsID',+            ccs_cc = ccs_cc',+            ccs_prevStack = ccs_prevStack',+            ccs_indexTable = ccs_indexTable',+            ccs_root = ccs_root',+            ccs_depth = ccs_depth',+            ccs_scc_count = ccs_scc_count',+            ccs_selected = ccs_selected',+            ccs_time_ticks = ccs_time_ticks',+            ccs_mem_alloc = ccs_mem_alloc',+            ccs_inherited_alloc = ccs_inherited_alloc',+            ccs_inherited_ticks = ccs_inherited_ticks'+        }+    where+        ptrAsInt = ptrToInt ptr++peekCostCentre :: IORef (AddressMap CostCentre) -> Ptr costCentre -> IO CostCentre+peekCostCentre costCenterCacheRef ptr = do+    costCenterCache <- readIORef costCenterCacheRef+    case IntMap.lookup ptrAsInt costCenterCache of+        (Just a) -> return a+        Nothing -> do+                    cc_ccID' <- (#peek struct CostCentre_, ccID) ptr+                    cc_label_ptr <- (#peek struct CostCentre_, label) ptr+                    cc_label' <- peekCString cc_label_ptr+                    cc_module_ptr <- (#peek struct CostCentre_, module) ptr+                    cc_module' <- peekCString cc_module_ptr+                    cc_srcloc_ptr <- (#peek struct CostCentre_, srcloc) ptr+                    cc_srcloc' <- do+                        if cc_srcloc_ptr == nullPtr then+                            return Nothing+                        else+                            fmap Just (peekCString cc_srcloc_ptr)+                    cc_mem_alloc' <- (#peek struct CostCentre_, mem_alloc) ptr+                    cc_time_ticks' <- (#peek struct CostCentre_, time_ticks) ptr+                    cc_is_caf' <- (#peek struct CostCentre_, is_caf) ptr+                    cc_link_ptr <- (#peek struct CostCentre_, link) ptr+                    cc_link' <- if cc_link_ptr == nullPtr then+                        return Nothing+                    else+                        fmap Just (peekCostCentre costCenterCacheRef cc_link_ptr)++                    let result = CostCentre {+                        cc_ccID = cc_ccID',+                        cc_label = cc_label',+                        cc_module = cc_module',+                        cc_srcloc = cc_srcloc',+                        cc_mem_alloc = cc_mem_alloc',+                        cc_time_ticks = cc_time_ticks',+                        cc_is_caf = cc_is_caf',+                        cc_link = cc_link'+                    }++                    writeIORef costCenterCacheRef (IntMap.insert ptrAsInt result costCenterCache)++                    return result+    where+        ptrAsInt = ptrToInt ptr++peekIndexTable :: AddressSet -> IORef (AddressMap CostCentre) -> Ptr indexTable -> IO (Maybe IndexTable)+peekIndexTable _ _ ptr | ptr == nullPtr = return Nothing+peekIndexTable loopBreakers costCenterCacheRef ptr = do+        it_cc_ptr <- (#peek struct IndexTable_, cc) ptr+        it_cc' <- peekCostCentre costCenterCacheRef it_cc_ptr+        it_ccs_ptr <- (#peek struct IndexTable_, ccs) ptr+        it_ccs' <- peekCostCentreStack loopBreakers costCenterCacheRef it_ccs_ptr+        it_next_ptr <- (#peek struct IndexTable_, next) ptr+        it_next' <- peekIndexTable loopBreakers costCenterCacheRef it_next_ptr+        it_back_edge' <- (#peek struct IndexTable_, back_edge) ptr++        return $ Just IndexTable {+            it_cc = it_cc',+            it_ccs = it_ccs',+            it_next = it_next',+            it_back_edge = it_back_edge'+        }++-- | casts a @Ptr@ to an @Int@+ptrToInt :: Ptr a -> Int+ptrToInt (Ptr a##) = I## (addr2Int## a##)++#else+import Prelude+import Foreign++import GHC.Exts.Heap.ProfInfo.Types++peekStgTSOProfInfo :: (Ptr b -> IO (Maybe CostCentreStack)) -> Ptr a -> IO (Maybe StgTSOProfInfo)+peekStgTSOProfInfo _ _ = return Nothing++peekTopCCS :: Ptr a -> IO (Maybe CostCentreStack)+peekTopCCS _ = return Nothing+#endif

@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveGeneric #-}++module GHC.Exts.Heap.ProfInfo.Types where++import Prelude+import Data.Word+import GHC.Generics++-- | This is a somewhat faithful representation of StgTSOProfInfo. See+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/storage/TSO.h>+-- for more details on this data structure.+data StgTSOProfInfo = StgTSOProfInfo {+    cccs :: Maybe CostCentreStack+} deriving (Show, Generic, Eq, Ord)++-- | This is a somewhat faithful representation of CostCentreStack. See+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/prof/CCS.h>+-- for more details on this data structure.+data CostCentreStack = CostCentreStack {+    ccs_ccsID :: Int,+    ccs_cc :: CostCentre,+    ccs_prevStack :: Maybe CostCentreStack,+    ccs_indexTable :: Maybe IndexTable,+    ccs_root :: Maybe CostCentreStack,+    ccs_depth :: Word,+    ccs_scc_count :: Word64,+    ccs_selected :: Word,+    ccs_time_ticks :: Word,+    ccs_mem_alloc :: Word64,+    ccs_inherited_alloc :: Word64,+    ccs_inherited_ticks :: Word+} deriving (Show, Generic, Eq, Ord)++-- | This is a somewhat faithful representation of CostCentre. See+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/prof/CCS.h>+-- for more details on this data structure.+data CostCentre = CostCentre {+    cc_ccID :: Int,+    cc_label :: String,+    cc_module :: String,+    cc_srcloc :: Maybe String,+    cc_mem_alloc :: Word64,+    cc_time_ticks :: Word,+    cc_is_caf :: Bool,+    cc_link :: Maybe CostCentre+} deriving (Show, Generic, Eq, Ord)++-- | This is a somewhat faithful representation of IndexTable. See+-- <https://gitlab.haskell.org/ghc/ghc/blob/master/includes/rts/prof/CCS.h>+-- for more details on this data structure.+data IndexTable = IndexTable {+    it_cc :: CostCentre,+    it_ccs :: Maybe CostCentreStack,+    it_next :: Maybe IndexTable,+    it_back_edge :: Bool+} deriving (Show, Generic, Eq, Ord)

@@ -11,7 +11,7 @@ import GHC.Exts.Heap.InfoTable  import Data.Char-import Data.List+import Data.List (intercalate) import Foreign import GHC.CString import GHC.Exts

@@ -1,6 +1,6 @@ cabal-version:  3.0 name:           ghc-heap-version:        9.0.1+version:        9.2.1 license:        BSD-3-Clause license-file:   LICENSE maintainer:     libraries@haskell.org@@ -23,8 +23,9 @@   default-language: Haskell2010    build-depends:    base             >= 4.9.0 && < 5.0-                  , ghc-prim         > 0.2 && < 0.8+                  , ghc-prim         > 0.2 && < 0.9                   , rts              == 1.0.*+                  , containers       >= 0.6.2.1 && < 0.7    ghc-options:      -Wall   cmm-sources:      cbits/HeapPrim.cmm@@ -39,3 +40,10 @@                     GHC.Exts.Heap.InfoTable.Types                     GHC.Exts.Heap.InfoTableProf                     GHC.Exts.Heap.Utils+                    GHC.Exts.Heap.FFIClosures+                    GHC.Exts.Heap.FFIClosures_ProfilingDisabled+                    GHC.Exts.Heap.FFIClosures_ProfilingEnabled+                    GHC.Exts.Heap.ProfInfo.Types+                    GHC.Exts.Heap.ProfInfo.PeekProfInfo+                    GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingDisabled+                    GHC.Exts.Heap.ProfInfo.PeekProfInfo_ProfilingEnabled