[Git][ghc/ghc][wip/decode_cloned_stack] 4 commits: Use StackFrameIter instead of BitmapEntry
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Fri Feb 3 15:23:52 UTC 2023
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
69405da8 by Sven Tennie at 2023-02-03T12:30:05+00:00
Use StackFrameIter instead of BitmapEntry
- - - - -
e1e3b80a by Sven Tennie at 2023-02-03T12:41:52+00:00
Update note
- - - - -
82bea903 by Sven Tennie at 2023-02-03T12:47:42+00:00
Cleanup
- - - - -
fe83579e by Sven Tennie at 2023-02-03T12:51:26+00:00
Remove unsafe cast
- - - - -
2 changed files:
- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -55,33 +55,37 @@ the same. (Though, the absolute addresses change!)
Stack frame iterator
====================
-A StackFrameIter consists of a StackSnapshot# and a relative offset into the the
-array of stack frames (StgStack->stack). The StackSnapshot# represents a
-StgStack closure. It is updated by the garbage collector when the stack closure
-is moved.
+A stack frame interator (StackFrameIter) consists of a StackSnapshot# and a
+relative offset into the the array of stack frames (StgStack->stack). The
+StackSnapshot# represents a StgStack closure. It is updated by the garbage
+collector when the stack closure is moved.
The relative offset describes the location of a stack frame. As stack frames
come in various sizes, one cannot simply step over the stack array with a
constant offset.
The head of the stack frame array has offset 0. To traverse the stack frames the
-latest stacke frame's offset is incremented by the closure size. The unit of the
+latest stack frame's offset is incremented by the closure size. The unit of the
offset is machine words (32bit or 64bit).
+Additionally, StackFrameIter contains a flag (isPrimitive) to indicate if a
+location on the stack should be interpreted as plain data word (in contrast to
+being a closure or a pointer to a closure.) It's used when bitmap encoded
+arguments are interpreted.
+
Boxes
=====
-As references into thestack frame array aren't updated by the garbage collector,
+As references into the stack frame array aren't updated by the garbage collector,
creating a Box with a pointer (address) to a stack frame would break as soon as
the StgStack closure is moved.
-To deal with this another kind of Box is introduced: A DecodedBox contains a
-thunk for a decoded stack frame or the closure for the decoded stack frame
-itself. I.e. we're not boxing the closure, but the ghc-heap representation of
-it.
+To deal with this another kind of Box is introduced: A StackFrameBox contains a
+stack frame iterator for a decoded stack frame or it's payload.
Heap-represented closures referenced by stack frames are boxed the usual way,
-with a Box that contains a pointer to the closure.
+with a Box that contains a pointer to the closure as it's payload. In
+Haskell-land this means: A Box which contains the closure.
Technical details
=================
@@ -157,7 +161,7 @@ getInfoTable StackFrameIter {..} =
let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index))
in peekItbl infoTablePtr
-foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Addr# #)
+foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #)
-- -- TODO: Remove this instance (debug only)
-- instance Show StackFrameIter where
@@ -178,18 +182,13 @@ advanceStackFrameIter (StackFrameIter {..}) =
primWordToWordOffset :: Word# -> WordOffset
primWordToWordOffset w# = fromIntegral (W# w#)
--- TODO: can be just StackFrameIter
-data BitmapEntry = BitmapEntry
- { closureFrame :: StackFrameIter }
-
-wordsToBitmapEntries :: StackFrameIter -> [Word] -> Word -> [BitmapEntry]
+wordsToBitmapEntries :: StackFrameIter -> [Word] -> Word -> [StackFrameIter]
wordsToBitmapEntries _ [] 0 = []
wordsToBitmapEntries _ [] i = error $ "Invalid state: Empty list, size " ++ show i
wordsToBitmapEntries _ l 0 = error $ "Invalid state: Size 0, list " ++ show l
wordsToBitmapEntries sfi (b : bs) bitmapSize =
let entries = toBitmapEntries sfi b (min bitmapSize (fromIntegral wORD_SIZE_IN_BITS))
- mbLastEntry = (listToMaybe . reverse) entries
- mbLastFrame = fmap closureFrame mbLastEntry
+ mbLastFrame = (listToMaybe . reverse) entries
in case mbLastFrame of
Just (StackFrameIter {..}) ->
entries ++ wordsToBitmapEntries (StackFrameIter stackSnapshot# (index + 1) False) bs (subtractDecodedBitmapWord bitmapSize)
@@ -198,29 +197,24 @@ wordsToBitmapEntries sfi (b : bs) bitmapSize =
subtractDecodedBitmapWord :: Word -> Word
subtractDecodedBitmapWord bSize = fromIntegral $ max 0 ((fromIntegral bSize) - wORD_SIZE_IN_BITS)
-toBitmapEntries :: StackFrameIter -> Word -> Word -> [BitmapEntry]
+toBitmapEntries :: StackFrameIter -> Word -> Word -> [StackFrameIter]
toBitmapEntries _ _ 0 = []
toBitmapEntries sfi@(StackFrameIter {..}) bitmapWord bSize =
-- TODO: overriding isPrimitive field is a bit weird. Could be calculated before
- BitmapEntry
- { closureFrame = sfi {
+ sfi {
isPrimitive = (bitmapWord .&. 1) /= 0
}
- }
: toBitmapEntries (StackFrameIter stackSnapshot# (index + 1) False) (bitmapWord `shiftR` 1) (bSize - 1)
-toBitmapPayload :: BitmapEntry -> IO Box
-toBitmapPayload e
- | (isPrimitive . closureFrame) e = trace "PRIM" $ pure . StackFrameBox $ (closureFrame e) {
- isPrimitive = True
- }
-toBitmapPayload e = getClosure (closureFrame e) 0
+toBitmapPayload :: StackFrameIter -> IO Box
+toBitmapPayload sfi | isPrimitive sfi = pure (StackFrameBox sfi)
+toBitmapPayload sfi = getClosure sfi 0
getClosure :: StackFrameIter -> WordOffset -> IO Box
getClosure sfi at StackFrameIter {..} relativeOffset = trace ("getClosure " ++ show sfi ++ " " ++ show relativeOffset) $
IO $ \s ->
case (getBoxedClosure# stackSnapshot# (wordOffsetToWord# (index + relativeOffset)) s) of (# s1, ptr #) ->
- (# s1, Box (unsafeCoerce# ptr) #)
+ (# s1, Box ptr #)
decodeLargeBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box]
decodeLargeBitmap getterFun# sfi@(StackFrameIter {..}) relativePayloadOffset = do
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -81,7 +81,6 @@ foreign import prim "eqStackSnapshotszh" eqStackSnapshots# :: StackSnapshot# ->
data StackFrameIter = StackFrameIter
{ stackSnapshot# :: !StackSnapshot#,
index :: !WordOffset,
- -- TODO: could be a sum type to prevent boolean-blindness
isPrimitive :: !Bool
}
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea608c2d3df40d7818c71b332fe4aa6b03e587f3...fe83579e946a3d6a8316bddccf554f51700529af
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea608c2d3df40d7818c71b332fe4aa6b03e587f3...fe83579e946a3d6a8316bddccf554f51700529af
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230203/f6438ce5/attachment-0001.html>
More information about the ghc-commits
mailing list