diff --git a/GHC/Exts/Heap.hs b/GHC/Exts/Heap.hs --- a/GHC/Exts/Heap.hs +++ b/GHC/Exts/Heap.hs @@ -1,13 +1,10 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE UnboxedTuples #-} - +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE ExplicitForAll #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE UnliftedFFITypes #-} @@ -157,7 +154,7 @@ let infoTablePtr = Ptr infoTableAddr ptrList = [case indexArray# pointersArray i of (# ptr #) -> Box ptr - | I# i <- [0..(I# (sizeofArray# pointersArray)) - 1] + | I# i <- [0..I# (sizeofArray# pointersArray) - 1] ] infoTable <- peekItbl infoTablePtr @@ -204,7 +201,7 @@ rawHeapWords :: [Word] rawHeapWords = [W# (indexWordArray# heapRep i) | I# i <- [0.. end] ] where - nelems = (I# (sizeofByteArray# heapRep)) `div` wORD_SIZE + nelems = I# (sizeofByteArray# heapRep) `div` wORD_SIZE end = fromIntegral nelems - 1 -- Just the payload of rawHeapWords (no header). @@ -236,7 +233,7 @@ fail "Expected at least 1 ptr argument to AP" -- We expect at least the arity, n_args, and fun fields unless (length payloadWords >= 2) $ - fail $ "Expected at least 2 raw words to AP" + fail "Expected at least 2 raw words to AP" let splitWord = payloadWords !! 0 pure $ APClosure itbl #if defined(WORDS_BIGENDIAN) @@ -340,14 +337,17 @@ -- pure $ OtherClosure itbl pts rawHeapWords -- - WEAK -> + WEAK -> do pure $ WeakClosure { info = itbl , cfinalizers = pts !! 0 , key = pts !! 1 , value = pts !! 2 , finalizer = pts !! 3 - , link = pts !! 4 + , weakLink = case drop 4 pts of + [] -> Nothing + [p] -> Just p + _ -> error $ "Expected 4 or 5 words in WEAK, found " ++ show (length pts) } TSO | [ u_lnk, u_gbl_lnk, tso_stack, u_trec, u_blk_ex, u_bq] <- pts -> withArray rawHeapWords (\ptr -> do diff --git a/GHC/Exts/Heap/ClosureTypes.hs b/GHC/Exts/Heap/ClosureTypes.hs --- a/GHC/Exts/Heap/ClosureTypes.hs +++ b/GHC/Exts/Heap/ClosureTypes.hs @@ -12,7 +12,7 @@ {- --------------------------------------------- -- Enum representing closure types -- This is a mirror of: --- includes/rts/storage/ClosureTypes.h +-- rts/include/rts/storage/ClosureTypes.h -- ---------------------------------------------} data ClosureType diff --git a/GHC/Exts/Heap/Closures.hs b/GHC/Exts/Heap/Closures.hs --- a/GHC/Exts/Heap/Closures.hs +++ b/GHC/Exts/Heap/Closures.hs @@ -41,6 +41,7 @@ import GHC.Exts.Heap.ProfInfo.Types import Data.Bits +import Data.Foldable (toList) import Data.Int import Data.Word import GHC.Exts @@ -98,7 +99,7 @@ type Closure = GenClosure Box -- | This is the representation of a Haskell value on the heap. It reflects --- +-- -- -- The data type is parametrized by `b`: the type to store references in. -- Usually this is a 'Box' with the type synonym 'Closure'. @@ -228,8 +229,8 @@ , mccPayload :: ![b] -- ^ Array payload } - -- | An @MVar#@, with a queue of thread state objects blocking on them - | MVarClosure + -- | An @MVar#@, with a queue of thread state objects blocking on them + | MVarClosure { info :: !StgInfoTable , queueHead :: !b -- ^ Pointer to head of queue , queueTail :: !b -- ^ Pointer to tail of queue @@ -265,7 +266,7 @@ , key :: !b , value :: !b , finalizer :: !b - , link :: !b -- ^ next weak pointer for the capability, can be NULL. + , weakLink :: !(Maybe b) -- ^ next weak pointer for the capability } -- | Representation of StgTSO: A Thread State Object. The values for @@ -386,9 +387,6 @@ | BlockedOnCCall | BlockedOnCCall_Interruptible | BlockedOnMsgThrowTo -#if __GLASGOW_HASKELL__ >= 811 && __GLASGOW_HASKELL__ < 902 - | BlockedOnIOCompletion -#endif | ThreadMigrating | WhyBlockedUnknownValue Word16 -- ^ Please report this as a bug deriving (Eq, Show, Generic, Ord) @@ -423,7 +421,7 @@ allClosures (IOPortClosure {..}) = [queueHead,queueTail,value] allClosures (FunClosure {..}) = ptrArgs allClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue] -allClosures (WeakClosure {..}) = [cfinalizers, key, value, finalizer, link] +allClosures (WeakClosure {..}) = [cfinalizers, key, value, finalizer] ++ Data.Foldable.toList weakLink allClosures (OtherClosure {..}) = hvalues allClosures _ = [] diff --git a/GHC/Exts/Heap/FFIClosures.hs b/GHC/Exts/Heap/FFIClosures.hs --- a/GHC/Exts/Heap/FFIClosures.hs +++ b/GHC/Exts/Heap/FFIClosures.hs @@ -29,12 +29,12 @@ -- -- # Future Work -- --- * Duplication of the code in the .hsc files could be reduced simply by +-- - 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 +-- - The correct solution would be for the build system to run `hsc2hs` with the -- correct cpp defines once per RTS flavour. -- diff --git a/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc b/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc --- a/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc +++ b/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc @@ -77,9 +77,6 @@ (#const BlockedOnCCall_Interruptible) -> BlockedOnCCall_Interruptible (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo (#const ThreadMigrating) -> ThreadMigrating -#if __GLASGOW_HASKELL__ >= 811 && __GLASGOW_HASKELL__ < 902 - (#const BlockedOnIOCompletion) -> BlockedOnIOCompletion -#endif _ -> WhyBlockedUnknownValue w parseTsoFlags :: Word32 -> [TsoFlags] diff --git a/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc b/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc --- a/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc +++ b/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc @@ -77,9 +77,6 @@ (#const BlockedOnCCall_Interruptible) -> BlockedOnCCall_Interruptible (#const BlockedOnMsgThrowTo) -> BlockedOnMsgThrowTo (#const ThreadMigrating) -> ThreadMigrating -#if __GLASGOW_HASKELL__ >= 811 && __GLASGOW_HASKELL__ < 902 - (#const BlockedOnIOCompletion) -> BlockedOnIOCompletion -#endif _ -> WhyBlockedUnknownValue w parseTsoFlags :: Word32 -> [TsoFlags] diff --git a/GHC/Exts/Heap/InfoTable/Types.hsc b/GHC/Exts/Heap/InfoTable/Types.hsc --- a/GHC/Exts/Heap/InfoTable/Types.hsc +++ b/GHC/Exts/Heap/InfoTable/Types.hsc @@ -28,7 +28,7 @@ type EntryFunPtr = FunPtr (Ptr () -> IO (Ptr ())) -- | This is a somewhat faithful representation of an info table. See --- +-- -- for more details on this data structure. data StgInfoTable = StgInfoTable { entry :: Maybe EntryFunPtr, -- Just <=> not TABLES_NEXT_TO_CODE diff --git a/GHC/Exts/Heap/ProfInfo/Types.hs b/GHC/Exts/Heap/ProfInfo/Types.hs --- a/GHC/Exts/Heap/ProfInfo/Types.hs +++ b/GHC/Exts/Heap/ProfInfo/Types.hs @@ -7,14 +7,14 @@ import GHC.Generics -- | This is a somewhat faithful representation of StgTSOProfInfo. See --- +-- -- for more details on this data structure. -data StgTSOProfInfo = StgTSOProfInfo { +newtype StgTSOProfInfo = StgTSOProfInfo { cccs :: Maybe CostCentreStack } deriving (Show, Generic, Eq, Ord) -- | This is a somewhat faithful representation of CostCentreStack. See --- +-- -- for more details on this data structure. data CostCentreStack = CostCentreStack { ccs_ccsID :: Int, @@ -32,7 +32,7 @@ } deriving (Show, Generic, Eq, Ord) -- | This is a somewhat faithful representation of CostCentre. See --- +-- -- for more details on this data structure. data CostCentre = CostCentre { cc_ccID :: Int, @@ -46,7 +46,7 @@ } deriving (Show, Generic, Eq, Ord) -- | This is a somewhat faithful representation of IndexTable. See --- +-- -- for more details on this data structure. data IndexTable = IndexTable { it_cc :: CostCentre, diff --git a/ghc-heap.cabal b/ghc-heap.cabal --- a/ghc-heap.cabal +++ b/ghc-heap.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: ghc-heap -version: 9.2.2 +version: 9.4.1 license: BSD-3-Clause license-file: LICENSE maintainer: libraries@haskell.org @@ -23,7 +23,7 @@ default-language: Haskell2010 build-depends: base >= 4.9.0 && < 5.0 - , ghc-prim > 0.2 && < 0.9 + , ghc-prim > 0.2 && < 0.10 , rts == 1.0.* , containers >= 0.6.2.1 && < 0.7