ghc-internal-9.1401.0: src/GHC/Internal/Heap/Closures.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LANGUAGE GHCForeignImportPrim #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UnliftedFFITypes #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
-- Late cost centres introduce a thunk in the asBox function, which leads to
-- an additional wrapper being added to any value placed inside a box.
-- This can be removed once our boot compiler is no longer affected by #25212
{-# OPTIONS_GHC -fno-prof-late #-}
{-# LANGUAGE NamedFieldPuns #-}
module GHC.Internal.Heap.Closures (
-- * Closures
Closure
, GenClosure(..)
, getClosureInfoTbl
, getClosureInfoTbl_maybe
, getClosurePtrArgs
, getClosurePtrArgs_maybe
, PrimType(..)
, WhatNext(..)
, WhyBlocked(..)
, TsoFlags(..)
, allClosures
, closureSize
-- * Stack
, StgStackClosure
, GenStgStackClosure(..)
, StackFrame
, GenStackFrame(..)
, StackField
, GenStackField(..)
-- * Boxes
, Box(..)
, areBoxesEqual
, asBox
) where
import GHC.Internal.Base
import GHC.Internal.Show
import GHC.Internal.Heap.Constants
#if defined(PROFILING)
import GHC.Internal.Heap.InfoTable () -- see Note [No way-dependent imports]
import GHC.Internal.Heap.InfoTableProf
#else
import GHC.Internal.Heap.InfoTable
import GHC.Internal.Heap.InfoTableProf () -- see Note [No way-dependent imports]
{-
Note [No way-dependent imports]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
`ghc -M` currently assumes that the imports for a module are the same
in every way. This is arguably a bug, but breaking this assumption by
importing different things in different ways can cause trouble. For
example, this module in the profiling way imports and uses
GHC.Exts.Heap.InfoTableProf. When it was not also imported in the
vanilla way, there were intermittent build failures due to this module
being compiled in the profiling way before GHC.Exts.Heap.InfoTableProf
in the profiling way. (#15197)
-}
#endif
import GHC.Internal.Heap.ProfInfo.Types
import GHC.Internal.Data.Bits
import GHC.Internal.Data.Foldable (Foldable, toList)
import GHC.Internal.Data.Traversable (Traversable)
import GHC.Internal.Int
import GHC.Internal.Num
import GHC.Internal.Real
import GHC.Internal.Word
import GHC.Internal.Exts
import GHC.Internal.Generics
import GHC.Internal.Numeric
import GHC.Internal.Stack (HasCallStack)
------------------------------------------------------------------------
-- Boxes
foreign import prim "aToWordzh" aToWord# :: Any -> Word#
foreign import prim "reallyUnsafePtrEqualityUpToTag"
reallyUnsafePtrEqualityUpToTag# :: Any -> Any -> Int#
-- | An arbitrary Haskell value in a safe Box. The point is that even
-- unevaluated thunks can safely be moved around inside the Box, and when
-- required, e.g. in 'getBoxedClosureData', the function knows how far it has
-- to evaluate the argument.
data Box = Box Any
instance Show Box where
-- From libraries/base/GHC/Ptr.lhs
showsPrec _ (Box a) rs =
-- unsafePerformIO (print "↓" >> pClosure a) `seq`
pad_out (showHex addr "") ++ (if tag>0 then "/" ++ show tag else "") ++ rs
where
ptr = W# (aToWord# a)
tag = ptr .&. fromIntegral tAG_MASK -- ((1 `shiftL` TAG_BITS) -1)
addr = ptr - tag
pad_out ls = '0':'x':ls
-- |This takes an arbitrary value and puts it into a box.
-- Note that calls like
--
-- > asBox (head list)
--
-- will put the thunk \"head list\" into the box, /not/ the element at the head
-- of the list. For that, use careful case expressions:
--
-- > case list of x:_ -> asBox x
asBox :: a -> Box
asBox x = Box (unsafeCoerce# x)
-- | Boxes can be compared, but this is not pure, as different heap objects can,
-- after garbage collection, become the same object.
areBoxesEqual :: Box -> Box -> IO Bool
areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of
0# -> pure False
_ -> pure True
------------------------------------------------------------------------
-- Closures
type Closure = GenClosure Box
-- | This is the representation of a Haskell value on the heap. It reflects
-- <https://gitlab.haskell.org/ghc/ghc/blob/master/rts/include/rts/storage/Closures.h>
--
-- 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
-- always refers to the info table pointed to by the header. The remaining
-- fields are the payload.
--
-- See
-- <https://gitlab.haskell.org/ghc/ghc/wikis/commentary/rts/storage/heap-objects>
-- for more information.
data GenClosure b
= -- | A data constructor
ConstrClosure
{ info :: !StgInfoTable
, ptrArgs :: ![b] -- ^ Pointer arguments
, dataArgs :: ![Word] -- ^ Non-pointer arguments
, pkg :: !String -- ^ Package name
, modl :: !String -- ^ Module name
, name :: !String -- ^ Constructor name
}
-- | A function
| FunClosure
{ info :: !StgInfoTable
, ptrArgs :: ![b] -- ^ Pointer arguments
, dataArgs :: ![Word] -- ^ Non-pointer arguments
}
-- | A thunk, an expression not obviously in head normal form
| ThunkClosure
{ info :: !StgInfoTable
, ptrArgs :: ![b] -- ^ Pointer arguments
, dataArgs :: ![Word] -- ^ Non-pointer arguments
}
-- | A thunk which performs a simple selection operation
| SelectorClosure
{ info :: !StgInfoTable
, selectee :: !b -- ^ Pointer to the object being
-- selected from
}
-- | An unsaturated function application
| PAPClosure
{ info :: !StgInfoTable
, arity :: !HalfWord -- ^ Arity of the partial application
, n_args :: !HalfWord -- ^ Size of the payload in words
, fun :: !b -- ^ Pointer to a 'FunClosure'
, payload :: ![b] -- ^ Sequence of already applied
-- arguments
}
-- In GHCi, if Linker.h would allow a reverse lookup, we could for exported
-- functions fun actually find the name here.
-- At least the other direction works via "lookupSymbol
-- base_GHCziBase_zpzp_closure" and yields the same address (up to tags)
-- | A function application
| APClosure
{ info :: !StgInfoTable
, arity :: !HalfWord -- ^ Always 0
, n_args :: !HalfWord -- ^ Size of payload in words
, fun :: !b -- ^ Pointer to a 'FunClosure'
, payload :: ![b] -- ^ Sequence of already applied
-- arguments
}
-- | A suspended thunk evaluation
| APStackClosure
{ info :: !StgInfoTable
, fun :: !b -- ^ Function closure
, payload :: ![b] -- ^ Stack right before suspension
}
-- | A pointer to another closure, introduced when a thunk is updated
-- to point at its value
| IndClosure
{ info :: !StgInfoTable
, indirectee :: !b -- ^ Target closure
}
-- | A byte-code object (BCO) which can be interpreted by GHC's byte-code
-- interpreter (e.g. as used by GHCi)
| BCOClosure
{ info :: !StgInfoTable
, instrs :: !b -- ^ A pointer to an ArrWords
-- of instructions
, literals :: !b -- ^ A pointer to an ArrWords
-- of literals
, bcoptrs :: !b -- ^ A pointer to an ArrWords
-- of byte code objects
, arity :: !HalfWord -- ^ The arity of this BCO
, size :: !HalfWord -- ^ The size of this BCO in words
, bitmap :: ![Word] -- ^ An StgLargeBitmap describing the
-- pointerhood of its args/free vars
}
-- | A thunk under evaluation by another thread
| BlackholeClosure
{ info :: !StgInfoTable
, indirectee :: !b -- ^ The target closure
}
-- | A @ByteArray#@
| ArrWordsClosure
{ info :: !StgInfoTable
, bytes :: !Word -- ^ Size of array in bytes
, arrWords :: ![Word] -- ^ Array payload
}
-- | A @MutableByteArray#@
| MutArrClosure
{ info :: !StgInfoTable
, mccPtrs :: !Word -- ^ Number of pointers
, mccSize :: !Word -- ^ ?? Closures.h vs ClosureMacros.h
, mccPayload :: ![b] -- ^ Array payload
-- 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
, queueHead :: !b -- ^ Pointer to head of queue
, queueTail :: !b -- ^ Pointer to tail of queue
, value :: !b -- ^ Pointer to closure
}
-- | A @MutVar#@
| MutVarClosure
{ info :: !StgInfoTable
, var :: !b -- ^ Pointer to contents
}
-- | An STM blocking queue.
| BlockingQueueClosure
{ info :: !StgInfoTable
, link :: !b -- ^ ?? Here so it looks like an IND
, blackHole :: !b -- ^ The blackhole closure
, owner :: !b -- ^ The owning thread state object
, queue :: !b -- ^ ??
}
| WeakClosure
{ info :: !StgInfoTable
, cfinalizers :: !b
, key :: !b
, value :: !b
, finalizer :: !b
, weakLink :: !(Maybe b) -- ^ next weak pointer for the capability
}
-- | 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
, thread_label :: !(Maybe 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
, stack_marking :: !Word8
}
------------------------------------------------------------
-- Unboxed unlifted closures
-- | Primitive Int
| IntClosure
{ ptipe :: PrimType
, intVal :: !Int }
-- | Primitive Word
| WordClosure
{ ptipe :: PrimType
, wordVal :: !Word }
-- | Primitive Int64
| Int64Closure
{ ptipe :: PrimType
, int64Val :: !Int64 }
-- | Primitive Word64
| Word64Closure
{ ptipe :: PrimType
, word64Val :: !Word64 }
-- | Primitive Addr
| AddrClosure
{ ptipe :: PrimType
, addrVal :: !(Ptr ()) }
-- | Primitive Float
| FloatClosure
{ ptipe :: PrimType
, floatVal :: !Float }
-- | Primitive Double
| DoubleClosure
{ ptipe :: PrimType
, doubleVal :: !Double }
-----------------------------------------------------------
-- Anything else
-- | Another kind of closure
| OtherClosure
{ info :: !StgInfoTable
, hvalues :: ![b]
, rawWords :: ![Word]
}
| UnsupportedClosure
{ info :: !StgInfoTable
}
-- | A primitive word from a bitmap encoded stack frame payload
--
-- The type itself cannot be restored (i.e. it might represent a Word8#
-- or an Int#).
| UnknownTypeWordSizedPrimitive
{ wordVal :: !Word }
deriving (Show, Generic, Functor, Foldable, Traversable)
-- | Get the info table for a heap closure, or Nothing for a prim value
--
-- @since 9.14.1
getClosureInfoTbl_maybe :: GenClosure b -> Maybe StgInfoTable
{-# INLINE getClosureInfoTbl_maybe #-} -- Ensure we can get rid of the just box
getClosureInfoTbl_maybe closure = case closure of
ConstrClosure{info} ->Just info
FunClosure{info} ->Just info
ThunkClosure{info} ->Just info
SelectorClosure{info} ->Just info
PAPClosure{info} ->Just info
APClosure{info} ->Just info
APStackClosure{info} ->Just info
IndClosure{info} ->Just info
BCOClosure{info} ->Just info
BlackholeClosure{info} ->Just info
ArrWordsClosure{info} ->Just info
MutArrClosure{info} ->Just info
SmallMutArrClosure{info} ->Just info
MVarClosure{info} ->Just info
MutVarClosure{info} ->Just info
BlockingQueueClosure{info} ->Just info
WeakClosure{info} ->Just info
TSOClosure{info} ->Just info
StackClosure{info} ->Just info
IntClosure{} -> Nothing
WordClosure{} -> Nothing
Int64Closure{} -> Nothing
Word64Closure{} -> Nothing
AddrClosure{} -> Nothing
FloatClosure{} -> Nothing
DoubleClosure{} -> Nothing
OtherClosure{info} -> Just info
UnsupportedClosure {info} -> Just info
UnknownTypeWordSizedPrimitive{} -> Nothing
-- | Partial version of getClosureInfoTbl_maybe for when we know we deal with a
-- heap closure.
--
-- @since 9.14.1
getClosureInfoTbl :: HasCallStack => GenClosure b -> StgInfoTable
getClosureInfoTbl closure = case getClosureInfoTbl_maybe closure of
Just info -> info
Nothing -> error "getClosureInfoTbl - Closure without info table"
-- | Get the info table for a heap closure, or Nothing for a prim value
--
-- @since 9.14.1
getClosurePtrArgs_maybe :: GenClosure b -> Maybe [b]
{-# INLINE getClosurePtrArgs_maybe #-} -- Ensure we can get rid of the just box
getClosurePtrArgs_maybe closure = case closure of
ConstrClosure{ptrArgs} -> Just ptrArgs
FunClosure{ptrArgs} -> Just ptrArgs
ThunkClosure{ptrArgs} -> Just ptrArgs
SelectorClosure{} -> Nothing
PAPClosure{} -> Nothing
APClosure{} -> Nothing
APStackClosure{} -> Nothing
IndClosure{} -> Nothing
BCOClosure{} -> Nothing
BlackholeClosure{} -> Nothing
ArrWordsClosure{} -> Nothing
MutArrClosure{} -> Nothing
SmallMutArrClosure{} -> Nothing
MVarClosure{} -> Nothing
MutVarClosure{} -> Nothing
BlockingQueueClosure{} -> Nothing
WeakClosure{} -> Nothing
TSOClosure{} -> Nothing
StackClosure{} -> Nothing
IntClosure{} -> Nothing
WordClosure{} -> Nothing
Int64Closure{} -> Nothing
Word64Closure{} -> Nothing
AddrClosure{} -> Nothing
FloatClosure{} -> Nothing
DoubleClosure{} -> Nothing
OtherClosure{} -> Nothing
UnsupportedClosure{} -> Nothing
UnknownTypeWordSizedPrimitive{} -> Nothing
-- | Partial version of getClosureInfoTbl_maybe for when we know we deal with a
-- heap closure.
--
-- @since 9.14.1
getClosurePtrArgs :: HasCallStack => GenClosure b -> [b]
getClosurePtrArgs closure = case getClosurePtrArgs_maybe closure of
Just ptrs -> ptrs
Nothing -> error "getClosurePtrArgs - Closure without ptrArgs field"
type StgStackClosure = GenStgStackClosure Box
-- | A decoded @StgStack@ with `StackFrame`s
--
-- Stack related data structures (`GenStgStackClosure`, `GenStackField`,
-- `GenStackFrame`) are defined separately from `GenClosure` as their related
-- functions are very different. Though, both are closures in the sense of RTS
-- structures, their decoding logic differs: While it's safe to keep a reference
-- to a heap closure, the garbage collector does not update references to stack
-- located closures.
--
-- Additionally, stack frames don't appear outside of the stack. Thus, keeping
-- `GenStackFrame` and `GenClosure` separated, makes these types more precise
-- (in the sense what values to expect.)
data GenStgStackClosure b = GenStgStackClosure
{ ssc_info :: !StgInfoTable
, ssc_stack_size :: !Word32 -- ^ stack size in *words*
, ssc_stack :: ![GenStackFrame b]
}
deriving (Foldable, Functor, Generic, Show, Traversable)
type StackField = GenStackField Box
-- | Bitmap-encoded payload on the stack
data GenStackField b
-- | A non-pointer field
= StackWord !Word
-- | A pointer field
| StackBox !b
deriving (Foldable, Functor, Generic, Show, Traversable)
type StackFrame = GenStackFrame Box
-- | A single stack frame
data GenStackFrame b =
UpdateFrame
{ info_tbl :: !StgInfoTable
, updatee :: !b
}
| CatchFrame
{ info_tbl :: !StgInfoTable
, handler :: !b
}
| CatchStmFrame
{ info_tbl :: !StgInfoTable
, catchFrameCode :: !b
, handler :: !b
}
| CatchRetryFrame
{ info_tbl :: !StgInfoTable
, running_alt_code :: !Word
, first_code :: !b
, alt_code :: !b
}
| AtomicallyFrame
{ info_tbl :: !StgInfoTable
, atomicallyFrameCode :: !b
, result :: !b
}
| UnderflowFrame
{ info_tbl :: !StgInfoTable
, nextChunk :: !(GenStgStackClosure b)
}
| StopFrame
{ info_tbl :: !StgInfoTable }
| RetSmall
{ info_tbl :: !StgInfoTable
, stack_payload :: ![GenStackField b]
}
| RetBig
{ info_tbl :: !StgInfoTable
, stack_payload :: ![GenStackField b]
}
| RetFun
{ info_tbl :: !StgInfoTable
, retFunSize :: !Word
, retFunFun :: !b
, retFunPayload :: ![GenStackField b]
}
| RetBCO
{ info_tbl :: !StgInfoTable
, bco :: !b -- ^ always a BCOClosure
, bcoArgs :: ![GenStackField b]
}
| AnnFrame
{ info_tbl :: !StgInfoTable
, annotation :: !b
}
deriving (Foldable, Functor, Generic, Show, Traversable)
data PrimType
= PInt
| PWord
| PInt64
| PWord64
| PAddr
| PFloat
| PDouble
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
| WhyBlockedUnknownValue Word16 -- ^ Please report this as a bug
deriving (Eq, Show, Generic, Ord)
data TsoFlags
= TsoLocked
| TsoBlockx
| TsoInterruptible
| TsoStoppedOnBreakpoint
| TsoMarked
| TsoSqueezed
| TsoAllocLimit
| TsoStopNextBreakpoint
| TsoStopAfterReturn
| 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
allClosures (ThunkClosure {..}) = ptrArgs
allClosures (SelectorClosure {..}) = [selectee]
allClosures (IndClosure {..}) = [indirectee]
allClosures (BlackholeClosure {..}) = [indirectee]
allClosures (APClosure {..}) = fun:payload
allClosures (PAPClosure {..}) = fun:payload
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
allClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue]
allClosures (WeakClosure {..}) = [cfinalizers, key, value, finalizer] ++ GHC.Internal.Data.Foldable.toList weakLink
allClosures (OtherClosure {..}) = hvalues
allClosures _ = []
-- | 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)