[Git][ghc/ghc][wip/decode_cloned_stack] 2 commits: Refactor: Extract decodeSmallBitmap
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sun Nov 20 11:03:21 UTC 2022
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
6dfdb5c7 by Sven Tennie at 2022-11-20T10:48:11+00:00
Refactor: Extract decodeSmallBitmap
- - - - -
ffe88bd9 by Sven Tennie at 2022-11-20T11:02:58+00:00
Refactor: extract getClosure
- - - - -
2 changed files:
- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/cbits/Stack.cmm
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -70,7 +70,9 @@ foreign import prim "getBCOLargeBitmapzh" getBCOLargeBitmap# :: StackSnapshot# -
foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: StackSnapshot# -> Word# -> (# ByteArray#, Word# #)
-foreign import prim "getSmallBitmapzh" getSmallBitmap# :: StackSnapshot# -> Word# -> (# Word#, Word#, Word# #)
+foreign import prim "getSmallBitmapzh" getSmallBitmap# :: StackSnapshot# -> Word# -> (# Word#, Word# #)
+
+foreign import prim "getRetSmallSpecialTypezh" getRetSmallSpecialType# :: StackSnapshot# -> Word# -> Word#
foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: StackSnapshot# -> Word# -> (# Word#, Word# #)
@@ -131,13 +133,24 @@ decodeLargeBitmap getterFun# stackFrame# closureOffset# relativePayloadOffset# =
in
payloads
+decodeSmallBitmap :: (StackSnapshot# -> Word# -> (# Word#, Word# #)) -> StackSnapshot# -> Word# -> Word# -> [BitmapPayload]
+decodeSmallBitmap getterFun# stackFrame# closureOffset# relativePayloadOffset# =
+ let !(# bitmap#, size# #) = getterFun# stackFrame# closureOffset#
+ bes = toBitmapEntries (StackFrameIter (# stackFrame#, plusWord# closureOffset# relativePayloadOffset# #))(W# bitmap#) (W# size#)
+ payloads = map toBitmapPayload bes
+ in
+ payloads
+
+getClosure :: StackFrameIter -> Int -> CL.Closure
+getClosure sfi relativeOffset = toClosure (unpackClosureReferencedByFrame# (intToWord# relativeOffset)) sfi
+
unpackStackFrameIter :: StackFrameIter -> StackFrame
unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
case (toEnum . fromIntegral) (W# (getInfoTableType# s# i#)) of
RET_BCO -> let
- instrs' = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgRetBCOFrameInstrs)) sfi
- literals' = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgRetBCOFrameLiterals)) sfi
- ptrs' = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgRetBCOFramePtrs)) sfi
+ instrs' = getClosure sfi offsetStgRetBCOFrameInstrs
+ literals' = getClosure sfi offsetStgRetBCOFrameLiterals
+ ptrs' = getClosure sfi offsetStgRetBCOFramePtrs
arity' = W# (getHalfWord# s# i# (intToWord# offsetStgRetBCOFrameArity))
size' = W# (getHalfWord# s# i# (intToWord# offsetStgRetBCOFrameSize))
payload' = decodeLargeBitmap getBCOLargeBitmap# s# i# 2##
@@ -150,9 +163,8 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
size = size',
payload = payload'
}
- RET_SMALL -> let !(# bitmap#, size#, special# #) = getSmallBitmap# s# i#
- bes = toBitmapEntries (StackFrameIter (# s#, plusWord# i# 1## #))(W# bitmap#) (W# size#)
- payloads = map toBitmapPayload bes
+ RET_SMALL -> let payloads = decodeSmallBitmap getSmallBitmap# s# i# 1##
+ special# = getRetSmallSpecialType# s# i#
special = (toEnum . fromInteger . toInteger) (W# special#)
in
RetSmall special payloads
@@ -162,9 +174,8 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
RET_FUN -> let
t = (toEnum . fromInteger . toInteger) (W# (getRetFunType# s# i#))
size = W# (getWord# s# i# (intToWord# offsetStgRetFunFrameSize))
- fun = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgRetFunFrameFun)) sfi
+ fun = getClosure sfi offsetStgRetFunFrameFun
payload =
- -- TODO: Much duplication with RET_SMALL and RET_BIG
case t of
ARG_GEN_BIG ->
let
@@ -173,21 +184,19 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
payloads
_ ->
let
- !(# bitmap#, size# #) = getRetFunSmallBitmap# s# i#
- bes = toBitmapEntries (StackFrameIter (# s#, plusWord# i# 2## #))(W# bitmap#) (W# size#)
- payloads = map toBitmapPayload bes
+ payloads = decodeSmallBitmap getRetFunSmallBitmap# s# i# 2##
in
payloads
in
RetFun t size fun payload
-- TODO: Decode update frame type
UPDATE_FRAME -> let
- c = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgUpdateFrameUpdatee)) sfi
+ c = getClosure sfi offsetStgUpdateFrameUpdatee
!t = (toEnum . fromInteger . toInteger) (W# (getUpdateFrameType# s# i#))
in
UpdateFrame t c
CATCH_FRAME -> let
- c = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgCatchFrameHandler)) sfi
+ c = getClosure sfi offsetStgCatchFrameHandler
-- TODO: Replace with getWord# expression
exceptionsBlocked = W# (getCatchFrameExceptionsBlocked# s# i#)
in
@@ -198,19 +207,19 @@ unpackStackFrameIter sfi@(StackFrameIter (# s#, i# #)) =
UnderflowFrame (StackSnapshot nextChunk#)
STOP_FRAME -> StopFrame
ATOMICALLY_FRAME -> let
- c = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgAtomicallyFrameCode)) sfi
- r = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgAtomicallyFrameResult)) sfi
+ c = getClosure sfi offsetStgAtomicallyFrameCode
+ r = getClosure sfi offsetStgAtomicallyFrameResult
in
AtomicallyFrame c r
CATCH_RETRY_FRAME -> let
running_alt_code = W# (getWord# s# i# (intToWord# offsetStgCatchRetryFrameRunningAltCode))
- first_code = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgCatchRetryFrameRunningFirstCode)) sfi
- alt_code = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgCatchRetryFrameRunningAltCode)) sfi
+ first_code = getClosure sfi offsetStgCatchRetryFrameRunningFirstCode
+ alt_code = getClosure sfi offsetStgCatchRetryFrameRunningAltCode
in
CatchRetryFrame running_alt_code first_code alt_code
CATCH_STM_FRAME -> let
- c = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgCatchSTMFrameCode)) sfi
- h = toClosure (unpackClosureReferencedByFrame# (intToWord# offsetStgCatchSTMFrameHandler)) sfi
+ c = getClosure sfi offsetStgCatchSTMFrameCode
+ h = getClosure sfi offsetStgCatchSTMFrameHandler
in
CatchStmFrame c h
x -> error $ "Unexpected closure type on stack: " ++ show x
=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -93,10 +93,19 @@ getSmallBitmapzh(P_ stack, W_ index) {
W_ bitmap, size, specialType;
(bitmap) = ccall getBitmapWord(c);
(size) = ccall getBitmapSize(c);
+
+ return (bitmap, size);
+}
+
+getRetSmallSpecialTypezh(P_ stack, W_ index) {
+ P_ c;
+ c = StgStack_sp(stack) + WDS(index);
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+ W_ specialType;
(specialType) = ccall getSpecialRetSmall(c);
- // ccall debugBelch("getSmallBitmapzh - bitmap %ul, size %ul\n", bitmap, size);
- return (bitmap, size, specialType);
+ return (specialType);
}
getRetFunSmallBitmapzh(P_ stack, W_ index) {
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff9d4c72fc0e1599d0317678028e12d852260a29...ffe88bd9ec034d1b621e73213506886d5b8a1a39
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ff9d4c72fc0e1599d0317678028e12d852260a29...ffe88bd9ec034d1b621e73213506886d5b8a1a39
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/20221120/c7336cfd/attachment-0001.html>
More information about the ghc-commits
mailing list