[Git][ghc/ghc][wip/decode_cloned_stack] 3 commits: Cleanup belching
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sat Oct 8 11:44:10 UTC 2022
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
d1df650c by Sven Tennie at 2022-10-08T10:47:49+00:00
Cleanup belching
- - - - -
45d76034 by Sven Tennie at 2022-10-08T11:40:18+00:00
Assert closures are valid
- - - - -
2f6ca800 by Sven Tennie at 2022-10-08T11:43:50+00:00
Assert more
- - - - -
3 changed files:
- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/cbits/Stack.c
- libraries/ghc-heap/cbits/Stack.cmm
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -69,16 +69,14 @@ 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) size =
- trace ("wordsToBitmapEntries - b " ++ show b ++ ", size " ++ show size)
- (let entries = toBitmapEntries sfi b (min size (fromIntegral wORD_SIZE_IN_BITS))
- mbLastEntry = (listToMaybe . reverse) entries
- mbLastFrame = fmap closureFrame mbLastEntry
+ let entries = toBitmapEntries sfi b (min size (fromIntegral wORD_SIZE_IN_BITS))
+ mbLastEntry = (listToMaybe . reverse) entries
+ mbLastFrame = fmap closureFrame mbLastEntry
in
case mbLastFrame of
Just (StackFrameIter (# s'#, i'# #)) ->
entries ++ wordsToBitmapEntries (StackFrameIter (# s'#, plusWord# i'# 1## #)) bs (subtractDecodedBitmapWord size)
Nothing -> error "This should never happen! Recursion ended not in base case."
- )
where
subtractDecodedBitmapWord :: Word -> Word
subtractDecodedBitmapWord size = fromIntegral $ max 0 ((fromIntegral size) - wORD_SIZE_IN_BITS)
@@ -114,13 +112,13 @@ unpackStackFrameIter (StackFrameIter (# s#, i# #)) =
RET_BCO -> RetBCO
RET_SMALL -> let !(# bitmap#, size# #) = getSmallBitmap# s# i#
bes = toBitmapEntries (StackFrameIter (# s#, plusWord# i# 1## #))(W# bitmap#) (W# size#)
- payloads = map toBitmapPayload (trace ("bes " ++ show bes) bes)
+ payloads = map toBitmapPayload bes
in
RetSmall None payloads
RET_BIG -> let !(# bitmapArray#, size# #) = getLargeBitmap# s# i#
bitmapWords :: [Word] = foldrByteArray (\w acc -> W# w : acc) [] bitmapArray#
bes = wordsToBitmapEntries (StackFrameIter (# s#, plusWord# i# 1## #)) (trace ("bitmapWords" ++ show bitmapWords) bitmapWords) (trace ("XXX size " ++ show (W# size#))(W# size#))
- payloads = map toBitmapPayload (trace ("unpackStackFrameIter - lenght " ++ show (length bes) ++ ", " ++ show bes ) bes)
+ payloads = map toBitmapPayload bes
in
RetBig payloads
RET_FUN -> RetFun
@@ -209,7 +207,7 @@ data StackFrame =
foreign import ccall "belchStack" belchStack# :: StackSnapshot# -> IO ()
belchStack :: StackSnapshot -> IO ()
-belchStack (StackSnapshot s#) = belchStack s#
+belchStack (StackSnapshot s#) = belchStack# s#
#endif
decodeStack :: StackSnapshot -> IO [StackFrame]
=====================================
libraries/ghc-heap/cbits/Stack.c
=====================================
@@ -1,22 +1,20 @@
#include "MachDeps.h"
#include "Rts.h"
#include "rts/Messages.h"
+#include "rts/Types.h"
#include "rts/storage/ClosureTypes.h"
#include "rts/storage/Closures.h"
#include "rts/storage/InfoTables.h"
-// Only exists to make the stack_frame_sizeW macro available in Haskell code
-// (via FFI).
-StgWord stackFrameSizeW(StgClosure *frame) {
- return stack_frame_sizeW(frame);
-}
-
StgWord stackFrameSize(StgStack* stack, StgWord index){
- return stackFrameSizeW(stack->sp + index);
+ StgClosure* c = (StgClosure *) stack->sp + index;
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+ return stack_frame_sizeW(c);
}
StgStack* getUnderflowFrameStack(StgStack* stack, StgWord index){
StgClosure* frame = stack->sp + index;
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(frame));
const StgRetInfoTable *info = get_ret_itbl((StgClosure *)frame);
if(info->i.type == UNDERFLOW_FRAME) {
@@ -28,6 +26,7 @@ StgStack* getUnderflowFrameStack(StgStack* stack, StgWord index){
// Only exists to make the get_itbl macro available in Haskell code (via FFI).
const StgInfoTable *getItbl(StgClosure *closure) {
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
// printObj(closure);
return get_itbl(closure);
};
@@ -80,13 +79,19 @@ StgWord getSpecialRetSmall(StgPtr sp) {
}
// TODO: Consider to use HSC
-StgWord getBitmapSize(StgInfoTable *info){
+StgWord getBitmapSize(StgClosure *c){
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+ StgInfoTable* info = get_itbl(c);
StgWord bitmap = info->layout.bitmap;
return BITMAP_SIZE(bitmap);
}
// TODO: Consider to use HSC
-StgWord getBitmapWord(StgInfoTable *info){
+StgWord getBitmapWord(StgClosure *c){
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+ StgInfoTable* info = get_itbl(c);
StgWord bitmap = info->layout.bitmap;
debugBelch("getBitmapWord - bitmap : %lu \n", bitmap);
StgWord bitmapWord = BITMAP_BITS(bitmap);
@@ -94,7 +99,10 @@ StgWord getBitmapWord(StgInfoTable *info){
return bitmapWord;
}
-StgWord getLargeBitmapSize(StgInfoTable *info){
+StgWord getLargeBitmapSize(StgClosure *c){
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+ StgInfoTable* info = get_itbl(c);
StgLargeBitmap* bitmap = GET_LARGE_BITMAP(info);
return bitmap->size;
}
@@ -105,7 +113,10 @@ StgWord getLargeBitmapSize(StgInfoTable *info){
#define SIZEOF_W SIZEOF_VOID_P
#define WDS(n) ((n)*SIZEOF_W)
-StgArrBytes* getLargeBitmaps(Capability *cap, StgInfoTable *info){
+StgArrBytes* getLargeBitmaps(Capability *cap, StgClosure *c){
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
+
+ StgInfoTable* info = get_itbl(c);
StgLargeBitmap* bitmap = GET_LARGE_BITMAP(info);
StgWord neededWords = ROUNDUP_BITS_TO_WDS(bitmap->size);
StgArrBytes* array = allocate(cap, sizeofW(StgArrBytes) + neededWords);
=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -71,12 +71,13 @@ getInfoTableTypezh (P_ stack, W_ index) {
}
getSmallBitmapzh(P_ stack, W_ index) {
- P_ itbl;
- itbl = %STD_INFO(%INFO_PTR(StgStack_sp(stack) + WDS(index)));
+ P_ c;
+ c = StgStack_sp(stack) + WDS(index);
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
W_ bitmap, size;
- (bitmap) = ccall getBitmapWord(itbl);
- (size) = ccall getBitmapSize(itbl);
+ (bitmap) = ccall getBitmapWord(c);
+ (size) = ccall getBitmapSize(c);
ccall debugBelch("getSmallBitmapzh - bitmap %ul, size %ul\n", bitmap, size);
return (bitmap, size);
@@ -90,12 +91,13 @@ unpackClosureFromStackFramezh(P_ stack, W_ index){
}
getLargeBitmapzh(P_ stack, W_ index){
- P_ itbl, stgArrBytes;
+ P_ c, stgArrBytes;
W_ size;
- itbl = %STD_INFO(%INFO_PTR(StgStack_sp(stack) + WDS(index)));
+ c = StgStack_sp(stack) + WDS(index);
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
- (stgArrBytes) = ccall getLargeBitmaps(MyCapability(), itbl);
- (size) = ccall getLargeBitmapSize(itbl);
+ (stgArrBytes) = ccall getLargeBitmaps(MyCapability(), c);
+ (size) = ccall getLargeBitmapSize(c);
ccall debugBelch("getLargeBitmapzh - size %ul\n", size);
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e623557539cbe4d907852920402724ac28a67bc...2f6ca800f8bc48ea749757654ebb926c7b6ea9eb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8e623557539cbe4d907852920402724ac28a67bc...2f6ca800f8bc48ea749757654ebb926c7b6ea9eb
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/20221008/f5974e91/attachment-0001.html>
More information about the ghc-commits
mailing list