[Git][ghc/ghc][wip/decode_cloned_stack] 3 commits: Delete some obsolete TODOs
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sat Feb 18 11:51:24 UTC 2023
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
8f8f7b80 by Sven Tennie at 2023-02-18T11:19:18+00:00
Delete some obsolete TODOs
- - - - -
45f10dca by Sven Tennie at 2023-02-18T11:48:39+00:00
Cleanup DecodeStack
- - - - -
f06baad7 by Sven Tennie at 2023-02-18T11:50:49+00:00
Remove redundant include
- - - - -
3 changed files:
- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/tests/stack_misc_closures_c.c
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -8,20 +8,20 @@
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeInType #-}
-{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
-- TODO: Find better place than top level. Re-export from top-level?
module GHC.Exts.DecodeStack
( decodeStack,
- unpackStackFrameIter
+ unpackStackFrameIter,
)
where
+
+import Data.Array.Byte
import Data.Bits
import Data.Maybe
-- TODO: Remove before releasing
@@ -33,11 +33,10 @@ import GHC.Exts.Heap.Closures
import GHC.Exts.Heap.Constants (wORD_SIZE_IN_BITS)
import GHC.Exts.Heap.InfoTable
import GHC.Exts.StackConstants
-import GHC.Stack.CloneStack
-import Prelude
import GHC.IO (IO (..))
-import Data.Array.Byte
+import GHC.Stack.CloneStack
import GHC.Word
+import Prelude
{- Note [Decoding the stack]
~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -103,11 +102,22 @@ Technical details
This keeps the code very portable.
-}
-foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #)
+type WordGetter = StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #)
+
+type LargeBitmapGetter = StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)
+
+type SmallBitmapGetter = StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #)
+
+foreign import prim "getUpdateFrameTypezh" getUpdateFrameType# :: WordGetter
getUpdateFrameType :: StackFrameIter -> IO UpdateFrameType
-getUpdateFrameType (SfiClosure {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s ->
- case (getUpdateFrameType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, uft# #) -> (# s1, W# uft# #))
+getUpdateFrameType (SfiClosure {..}) =
+ toEnum . fromInteger . toInteger
+ <$> IO
+ ( \s ->
+ case getUpdateFrameType# stackSnapshot# (wordOffsetToWord# index) s of
+ (# s1, uft# #) -> (# s1, W# uft# #)
+ )
getUpdateFrameType sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi
foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, StackSnapshot# #)
@@ -122,37 +132,61 @@ foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# ->
getWord :: StackFrameIter -> WordOffset -> IO Word
getWord (SfiPrimitive {..}) relativeOffset = IO $ \s ->
- case getWord# stackSnapshot# (wordOffsetToWord# index) (wordOffsetToWord# relativeOffset) s of
+ case getWord#
+ stackSnapshot#
+ (wordOffsetToWord# index)
+ (wordOffsetToWord# relativeOffset)
+ s of
(# s1, w# #) -> (# s1, W# w# #)
getWord (SfiClosure {..}) relativeOffset = IO $ \s ->
- case getWord# stackSnapshot# (wordOffsetToWord# index) (wordOffsetToWord# relativeOffset) s of
+ case getWord#
+ stackSnapshot#
+ (wordOffsetToWord# index)
+ (wordOffsetToWord# relativeOffset)
+ s of
(# s1, w# #) -> (# s1, W# w# #)
getWord sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi
-foreign import prim "getRetFunTypezh" getRetFunType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #)
+foreign import prim "getRetFunTypezh" getRetFunType# :: WordGetter
-- TODO: Could use getWord
getRetFunType :: StackFrameIter -> IO RetFunType
-getRetFunType (SfiClosure {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s ->
- case (getRetFunType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, rft# #) -> (# s1, W# rft# #))
+getRetFunType (SfiClosure {..}) =
+ toEnum . fromInteger . toInteger
+ <$> IO
+ ( \s ->
+ case getRetFunType#
+ stackSnapshot#
+ (wordOffsetToWord# index)
+ s of
+ (# s1, rft# #) -> (# s1, W# rft# #)
+ )
getRetFunType sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi
-foreign import prim "getLargeBitmapzh" getLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)
+foreign import prim "getLargeBitmapzh" getLargeBitmap# :: LargeBitmapGetter
-foreign import prim "getBCOLargeBitmapzh" getBCOLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)
+foreign import prim "getBCOLargeBitmapzh" getBCOLargeBitmap# :: LargeBitmapGetter
-foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)
+foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: LargeBitmapGetter
-foreign import prim "getSmallBitmapzh" getSmallBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #)
+foreign import prim "getSmallBitmapzh" getSmallBitmap# :: SmallBitmapGetter
-foreign import prim "getRetSmallSpecialTypezh" getRetSmallSpecialType# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word# #)
+foreign import prim "getRetSmallSpecialTypezh" getRetSmallSpecialType# :: WordGetter
getRetSmallSpecialType :: StackFrameIter -> IO SpecialRetSmall
-getRetSmallSpecialType (SfiClosure {..}) = (toEnum . fromInteger . toInteger) <$> IO (\s ->
- case (getRetSmallSpecialType# stackSnapshot# (wordOffsetToWord# index) s) of (# s1, rft# #) -> (# s1, W# rft# #))
+getRetSmallSpecialType (SfiClosure {..}) =
+ toEnum . fromInteger . toInteger
+ <$> IO
+ ( \s ->
+ case getRetSmallSpecialType#
+ stackSnapshot#
+ (wordOffsetToWord# index)
+ s of
+ (# s1, rft# #) -> (# s1, W# rft# #)
+ )
getRetSmallSpecialType sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi
-foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #)
+foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: SmallBitmapGetter
foreign import prim "advanceStackFrameIterzh" advanceStackFrameIter# :: StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #)
@@ -164,7 +198,9 @@ getInfoTable :: StackFrameIter -> IO StgInfoTable
getInfoTable SfiClosure {..} =
let infoTablePtr = Ptr (getInfoTableAddr# stackSnapshot# (wordOffsetToWord# index))
in peekItbl infoTablePtr
-getInfoTable SfiStackClosure {..} = peekItbl $ Ptr (getStackInfoTableAddr# stackSnapshot#)
+getInfoTable SfiStackClosure {..} =
+ peekItbl $
+ Ptr (getStackInfoTableAddr# stackSnapshot#)
getInfoTable _ = error "Primitives have no info table!"
foreign import prim "getBoxedClosurezh" getBoxedClosure# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Any #)
@@ -173,8 +209,9 @@ foreign import prim "getStackFieldszh" getStackFields# :: StackSnapshot# -> Stat
getStackFields :: StackFrameIter -> IO (Word32, Word8, Word8)
getStackFields SfiStackClosure {..} = IO $ \s ->
- case getStackFields# stackSnapshot# s of (# s1, sSize#, sDirty#, sMarking# #)
- -> (# s1, (W32# sSize#, W8# sDirty#, W8# sMarking#) #)
+ case getStackFields# stackSnapshot# s of
+ (# s1, sSize#, sDirty#, sMarking# #) ->
+ (# s1, (W32# sSize#, W8# sDirty#, W8# sMarking#) #)
getStackFields sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi
-- | Get an interator starting with the top-most stack frame
@@ -185,7 +222,7 @@ stackHead (StackSnapshot s) = SfiClosure s 0 -- GHC stacks are never empty
advanceStackFrameIter :: StackFrameIter -> Maybe StackFrameIter
advanceStackFrameIter (SfiClosure {..}) =
let !(# s', i', hasNext #) = advanceStackFrameIter# stackSnapshot# (wordOffsetToWord# index)
- in if (I# hasNext) > 0
+ in if I# hasNext > 0
then Just $ SfiClosure s' (primWordToWordOffset i')
else Nothing
advanceStackFrameIter sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi
@@ -202,35 +239,57 @@ wordsToBitmapEntries sfi (b : bs) bitmapSize =
mbLastFrame = (listToMaybe . reverse) entries
in case mbLastFrame of
Just (SfiClosure {..}) ->
- entries ++ wordsToBitmapEntries (SfiClosure stackSnapshot# (index + 1)) bs (subtractDecodedBitmapWord bitmapSize)
+ entries
+ ++ wordsToBitmapEntries
+ ( SfiClosure stackSnapshot# (index + 1)
+ )
+ bs
+ (subtractDecodedBitmapWord bitmapSize)
Just (SfiPrimitive {..}) ->
- entries ++ wordsToBitmapEntries (SfiClosure stackSnapshot# (index + 1)) bs (subtractDecodedBitmapWord bitmapSize)
+ entries
+ ++ wordsToBitmapEntries
+ ( SfiClosure stackSnapshot# (index + 1)
+ )
+ bs
+ (subtractDecodedBitmapWord bitmapSize)
_ -> error "This should never happen! Recursion ended not in base case."
where
subtractDecodedBitmapWord :: Word -> Word
- subtractDecodedBitmapWord bSize = fromIntegral $ max 0 ((fromIntegral bSize) - wORD_SIZE_IN_BITS)
+ subtractDecodedBitmapWord bSize =
+ fromIntegral $
+ max 0 (fromIntegral bSize - wORD_SIZE_IN_BITS)
toBitmapEntries :: StackFrameIter -> Word -> Word -> [StackFrameIter]
toBitmapEntries _ _ 0 = []
toBitmapEntries (SfiClosure {..}) bitmapWord bSize =
- -- TODO: overriding isPrimitive field is a bit weird. Could be calculated before
- (if (bitmapWord .&. 1) /= 0 then SfiPrimitive stackSnapshot# index else SfiClosure stackSnapshot# index)
- : toBitmapEntries (SfiClosure stackSnapshot# (index + 1)) (bitmapWord `shiftR` 1) (bSize - 1)
+ ( if (bitmapWord .&. 1) /= 0
+ then SfiPrimitive stackSnapshot# index
+ else SfiClosure stackSnapshot# index
+ )
+ : toBitmapEntries
+ ( SfiClosure stackSnapshot# (index + 1)
+ )
+ (bitmapWord `shiftR` 1)
+ (bSize - 1)
toBitmapEntries sfi _ _ = error $ "Unexpected StackFrameIter type: " ++ show sfi
toBitmapPayload :: StackFrameIter -> IO Box
-toBitmapPayload sfi at SfiPrimitive{} = pure (StackFrameBox sfi)
-toBitmapPayload sfi at SfiClosure{} = getClosure sfi 0
+toBitmapPayload sfi at SfiPrimitive {} = pure (StackFrameBox sfi)
+toBitmapPayload sfi at SfiClosure {} = getClosure sfi 0
toBitmapPayload sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi
getClosure :: StackFrameIter -> WordOffset -> IO Box
getClosure sfi at SfiClosure {..} relativeOffset = trace ("getClosure " ++ show sfi ++ " " ++ show relativeOffset) $
- IO $ \s ->
- case (getBoxedClosure# stackSnapshot# (wordOffsetToWord# (index + relativeOffset)) s) of (# s1, ptr #) ->
- (# s1, Box ptr #)
+ IO $ \s ->
+ case getBoxedClosure#
+ stackSnapshot#
+ (wordOffsetToWord# (index + relativeOffset))
+ s of
+ (# s1, ptr #) ->
+ (# s1, Box ptr #)
getClosure sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi
-decodeLargeBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, ByteArray#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box]
+decodeLargeBitmap :: LargeBitmapGetter -> StackFrameIter -> WordOffset -> IO [Box]
decodeLargeBitmap getterFun# sfi@(SfiClosure {..}) relativePayloadOffset = do
(bitmapArray, size) <- IO $ \s ->
case getterFun# stackSnapshot# (wordOffsetToWord# index) s of
@@ -245,20 +304,23 @@ decodeBitmaps (SfiClosure {..}) relativePayloadOffset bitmapWords size =
in mapM toBitmapPayload bes
decodeBitmaps sfi _ _ _ = error $ "Unexpected StackFrameIter type: " ++ show sfi
-decodeSmallBitmap :: (StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, Word#, Word# #)) -> StackFrameIter -> WordOffset -> IO [Box]
-decodeSmallBitmap getterFun# sfi@(SfiClosure {..}) relativePayloadOffset = do
- (bitmap, size) <- IO $ \s ->
- case getterFun# stackSnapshot# (wordOffsetToWord# index) s of
- (# s1, b# , s# #) -> (# s1, (W# b# , W# s#) #)
- let bitmapWords = if size > 0 then [bitmap] else []
- decodeBitmaps sfi relativePayloadOffset bitmapWords size
-decodeSmallBitmap _ sfi _ = error $ "Unexpected StackFrameIter type: " ++ show sfi
+decodeSmallBitmap :: SmallBitmapGetter -> StackFrameIter -> WordOffset -> IO [Box]
+decodeSmallBitmap getterFun# sfi@(SfiClosure {..}) relativePayloadOffset =
+ do
+ (bitmap, size) <- IO $ \s ->
+ case getterFun# stackSnapshot# (wordOffsetToWord# index) s of
+ (# s1, b#, s# #) -> (# s1, (W# b#, W# s#) #)
+ let bitmapWords = [bitmap | size > 0]
+ decodeBitmaps sfi relativePayloadOffset bitmapWords size
+decodeSmallBitmap _ sfi _ =
+ error $
+ "Unexpected StackFrameIter type: " ++ show sfi
byteArrayToList :: ByteArray -> [Word]
byteArrayToList (ByteArray bArray) = go 0
where
go i
- | i < maxIndex = (W# (indexWordArray# bArray (toInt# i))) : (go (i + 1))
+ | i < maxIndex = W# (indexWordArray# bArray (toInt# i)) : go (i + 1)
| otherwise = []
maxIndex = sizeofByteArray bArray `quot` sizeOf (undefined :: Word)
@@ -266,20 +328,23 @@ wordOffsetToWord# :: WordOffset -> Word#
wordOffsetToWord# wo = intToWord# (fromIntegral wo)
unpackStackFrameIter :: StackFrameIter -> IO Closure
-unpackStackFrameIter sfi@(SfiPrimitive { }) = UnknownTypeWordSizedPrimitive <$> (getWord sfi 0)
+unpackStackFrameIter sfi@(SfiPrimitive {}) =
+ UnknownTypeWordSizedPrimitive
+ <$> getWord sfi 0
unpackStackFrameIter sfi@(SfiStackClosure {}) = do
info <- getInfoTable sfi
(stack_size', stack_dirty', stack_marking') <- getStackFields sfi
case tipe info of
STACK -> do
let stack' = decodeStack' (StackSnapshot (stackSnapshot# sfi))
- pure $ StackClosure {
- info = info,
- stack_size = stack_size',
- stack_dirty = stack_dirty',
- stack_marking = stack_marking',
- stack = stack'
- }
+ pure $
+ StackClosure
+ { info = info,
+ stack_size = stack_size',
+ stack_dirty = stack_dirty',
+ stack_marking = stack_marking',
+ stack = stack'
+ }
_ -> error $ "Expected STACK closure, got " ++ show info
unpackStackFrameIter sfi@(SfiClosure {}) = do
traceM $ "unpackStackFrameIter - sfi " ++ show sfi
@@ -295,26 +360,29 @@ unpackStackFrameIter sfi@(SfiClosure {}) = do
bco' <- getClosure sfi offsetStgClosurePayload
-- The arguments begin directly after the payload's one element
bcoArgs' <- decodeLargeBitmap getBCOLargeBitmap# sfi (offsetStgClosurePayload + 1)
- pure $ RetBCO
- { info = info,
- bco = bco',
- bcoArgs = bcoArgs'
- }
+ pure $
+ RetBCO
+ { info = info,
+ bco = bco',
+ bcoArgs = bcoArgs'
+ }
RET_SMALL ->
trace "RET_SMALL" $ do
- payload' <- decodeSmallBitmap getSmallBitmap# sfi offsetStgClosurePayload
- knownRetSmallType' <- getRetSmallSpecialType sfi
- pure $ RetSmall
- { info = info,
- knownRetSmallType = knownRetSmallType',
- payload = payload'
- }
+ payload' <- decodeSmallBitmap getSmallBitmap# sfi offsetStgClosurePayload
+ knownRetSmallType' <- getRetSmallSpecialType sfi
+ pure $
+ RetSmall
+ { info = info,
+ knownRetSmallType = knownRetSmallType',
+ payload = payload'
+ }
RET_BIG -> do
payload' <- decodeLargeBitmap getLargeBitmap# sfi offsetStgClosurePayload
- pure $ RetBig
- { info = info,
- payload = payload'
- }
+ pure $
+ RetBig
+ { info = info,
+ payload = payload'
+ }
RET_FUN -> do
retFunType' <- getRetFunType sfi
retFunSize' <- getWord sfi offsetStgRetFunFrameSize
@@ -323,62 +391,69 @@ unpackStackFrameIter sfi@(SfiClosure {}) = do
if retFunType' == ARG_GEN_BIG
then decodeLargeBitmap getRetFunLargeBitmap# sfi offsetStgRetFunFramePayload
else decodeSmallBitmap getRetFunSmallBitmap# sfi offsetStgRetFunFramePayload
- pure $ RetFun
- { info = info,
- retFunType = retFunType',
- retFunSize = retFunSize',
- retFunFun = retFunFun',
- retFunPayload = retFunPayload'
- }
+ pure $
+ RetFun
+ { info = info,
+ retFunType = retFunType',
+ retFunSize = retFunSize',
+ retFunFun = retFunFun',
+ retFunPayload = retFunPayload'
+ }
UPDATE_FRAME -> do
updatee' <- getClosure sfi offsetStgUpdateFrameUpdatee
knownUpdateFrameType' <- getUpdateFrameType sfi
- pure $ UpdateFrame
- { info = info,
- knownUpdateFrameType = knownUpdateFrameType',
- updatee = updatee'
- }
+ pure $
+ UpdateFrame
+ { info = info,
+ knownUpdateFrameType = knownUpdateFrameType',
+ updatee = updatee'
+ }
CATCH_FRAME -> do
exceptions_blocked' <- getWord sfi offsetStgCatchFrameExceptionsBlocked
handler' <- getClosure sfi offsetStgCatchFrameHandler
- pure $ CatchFrame
- { info = info,
- exceptions_blocked = exceptions_blocked',
- handler = handler'
- }
+ pure $
+ CatchFrame
+ { info = info,
+ exceptions_blocked = exceptions_blocked',
+ handler = handler'
+ }
UNDERFLOW_FRAME -> do
(StackSnapshot nextChunk') <- getUnderflowFrameNextChunk sfi
- pure $ UnderflowFrame
- { info = info,
- nextChunk = StackFrameBox $ SfiStackClosure nextChunk'
- }
+ pure $
+ UnderflowFrame
+ { info = info,
+ nextChunk = StackFrameBox $ SfiStackClosure nextChunk'
+ }
STOP_FRAME -> pure $ StopFrame {info = info}
ATOMICALLY_FRAME -> do
atomicallyFrameCode' <- getClosure sfi offsetStgAtomicallyFrameCode
result' <- getClosure sfi offsetStgAtomicallyFrameResult
- pure $ AtomicallyFrame
- { info = info,
- atomicallyFrameCode = atomicallyFrameCode',
- result = result'
- }
+ pure $
+ AtomicallyFrame
+ { info = info,
+ atomicallyFrameCode = atomicallyFrameCode',
+ result = result'
+ }
CATCH_RETRY_FRAME -> do
running_alt_code' <- getWord sfi offsetStgCatchRetryFrameRunningAltCode
first_code' <- getClosure sfi offsetStgCatchRetryFrameRunningFirstCode
alt_code' <- getClosure sfi offsetStgCatchRetryFrameAltCode
- pure $ CatchRetryFrame
- { info = info,
- running_alt_code = running_alt_code',
- first_code = first_code',
- alt_code = alt_code'
- }
+ pure $
+ CatchRetryFrame
+ { info = info,
+ running_alt_code = running_alt_code',
+ first_code = first_code',
+ alt_code = alt_code'
+ }
CATCH_STM_FRAME -> do
catchFrameCode' <- getClosure sfi offsetStgCatchSTMFrameCode
handler' <- getClosure sfi offsetStgCatchSTMFrameHandler
- pure $ CatchStmFrame
- { info = info,
- catchFrameCode = catchFrameCode',
- handler = handler'
- }
+ pure $
+ CatchStmFrame
+ { info = info,
+ catchFrameCode = catchFrameCode',
+ handler = handler'
+ }
x -> error $ "Unexpected closure type on stack: " ++ show x
-- | Size of the byte array in bytes.
@@ -395,14 +470,19 @@ intToWord# :: Int -> Word#
intToWord# i = int2Word# (toInt# i)
decodeStack :: StackSnapshot -> IO Closure
-decodeStack (StackSnapshot stack#) = unpackStackFrameIter $ SfiStackClosure stack#
+decodeStack (StackSnapshot stack#) =
+ unpackStackFrameIter $
+ SfiStackClosure stack#
decodeStack' :: StackSnapshot -> [Box]
-decodeStack' s = StackFrameBox (stackHead s) : go (advanceStackFrameIter (stackHead s))
+decodeStack' s =
+ StackFrameBox (stackHead s)
+ : go (advanceStackFrameIter (stackHead s))
where
go :: Maybe StackFrameIter -> [Box]
go Nothing = []
- go (Just sfi) = (StackFrameBox sfi) : go (advanceStackFrameIter sfi)
+ go (Just sfi) = StackFrameBox sfi : go (advanceStackFrameIter sfi)
+
#else
module GHC.Exts.DecodeStack where
#endif
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -124,7 +124,6 @@ data Box =
data Box = Box Any
#endif
--- TODO: Handle PrimitiveWordHolder
instance Show Box where
-- From libraries/base/GHC/Ptr.lhs
showsPrec _ (Box a) rs =
@@ -142,7 +141,6 @@ instance Show Box where
-- | Boxes can be compared, but this is not pure, as different heap objects can,
-- after garbage collection, become the same object.
--- TODO: Handle PrimitiveWordHolder
areBoxesEqual :: Box -> Box -> IO Bool
areBoxesEqual (Box a) (Box b) = case reallyUnsafePtrEqualityUpToTag# a b of
0# -> pure False
@@ -410,7 +408,6 @@ data GenClosure b
, result :: !b
}
- -- TODO: nextChunk could be a CL.Closure, too! (StackClosure)
| UnderflowFrame
{ info :: !StgInfoTable
, nextChunk :: !b
=====================================
libraries/ghc-heap/tests/stack_misc_closures_c.c
=====================================
@@ -1,7 +1,6 @@
#include "MachDeps.h"
#include "Rts.h"
#include "RtsAPI.h"
-#include "alloca.h"
#include "rts/Messages.h"
#include "rts/Types.h"
#include "rts/storage/ClosureMacros.h"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6c695217efd4384a62fdaa9be1acd2de37499514...f06baad78de1561d07e31a8fb19bb1f8df945094
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6c695217efd4384a62fdaa9be1acd2de37499514...f06baad78de1561d07e31a8fb19bb1f8df945094
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/20230218/0527f474/attachment-0001.html>
More information about the ghc-commits
mailing list