[Git][ghc/ghc][wip/decode_cloned_stack] 6 commits: Delete debug print statement
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sat Jan 21 14:36:19 UTC 2023
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
83228de7 by Sven Tennie at 2023-01-21T14:04:06+00:00
Delete debug print statement
- - - - -
2a637d44 by Sven Tennie at 2023-01-21T14:10:45+00:00
Make (hopefully) i386 compatible
- - - - -
db645dce by Sven Tennie at 2023-01-21T14:15:39+00:00
Reorder declarations
- - - - -
7c9a83cd by Sven Tennie at 2023-01-21T14:17:21+00:00
Cleanup
- - - - -
ba1872a3 by Sven Tennie at 2023-01-21T14:27:45+00:00
Rename index and offset explaining their unit
- - - - -
bc141e9b by Sven Tennie at 2023-01-21T14:33:23+00:00
Reduce duplication
- - - - -
2 changed files:
- libraries/ghc-heap/GHC/Exts/DecodeStack.hs
- libraries/ghc-heap/cbits/Stack.cmm
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/DecodeStack.hs
=====================================
@@ -241,18 +241,8 @@ foreign import prim "getWordzh" getWord# :: StackSnapshot# -> Word# -> Word# ->
foreign import prim "getRetFunTypezh" getRetFunType# :: StackSnapshot# -> Word# -> Word#
-#if defined(DEBUG)
-foreign import ccall "belchStack" belchStack# :: StackSnapshot# -> IO ()
-
-belchStack :: StackSnapshot -> IO ()
-belchStack (StackSnapshot s#) = belchStack# s#
-#endif
-
decodeStack :: StackSnapshot -> IO CL.Closure
decodeStack s = do
-#if defined(DEBUG)
- belchStack s
-#endif
stack <- decodeStack' s
let boxed = map DecodedClosureBox stack
pure $ SimpleStack boxed
=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -1,53 +1,41 @@
#include "Cmm.h"
-#if SIZEOF_VOID_P == 4
-#define HALF_WORD_ bits16
-#elif SIZEOF_VOID_P == 8
-#define HALF_WORD_ bits32
-#else
-#error Unknown word size
-#endif
-
// TODO: comment out
// Uncomment to enable assertions during development
#define DEBUG 1
-advanceStackFrameIterzh (P_ stack, W_ index) {
- P_ newStack;
- W_ newIndex;
- W_ hasNext;
-
+advanceStackFrameIterzh (P_ stack, W_ offsetWords) {
W_ frameSize;
- (frameSize) = ccall stackFrameSize(stack, index);
+ (frameSize) = ccall stackFrameSize(stack, offsetWords);
P_ nextClosurePtr;
- nextClosurePtr = (StgStack_sp(stack) + WDS(index) + WDS(frameSize));
+ nextClosurePtr = (StgStack_sp(stack) + WDS(offsetWords) + WDS(frameSize));
- P_ stackBottom, stackArrayPtr;
+ P_ stackArrayPtr;
stackArrayPtr = stack + SIZEOF_StgHeader + OFFSET_StgStack_stack;
- HALF_WORD_ stackSize;
- W_ stackSizeInBytes;
- stackSize = StgStack_stack_size(stack);
- stackSizeInBytes = WDS(TO_W_(stackSize));
+
+ P_ stackBottom;
+ W_ stackSize, stackSizeInBytes;
+ stackSize = TO_W_(StgStack_stack_size(stack));
+ stackSizeInBytes = WDS(stackSize);
stackBottom = stackSizeInBytes + stackArrayPtr;
+ P_ newStack;
+ W_ newOffsetWords, hasNext;
if(nextClosurePtr < stackBottom) (likely: True) {
- // ccall debugBelch("advanceStackFrameIterzh - ordinary frame \n");
newStack = stack;
- newIndex = index + frameSize;
+ newOffsetWords = offsetWords + frameSize;
hasNext = 1;
} else {
P_ underflowFrameStack;
- (underflowFrameStack) = ccall getUnderflowFrameStack(stack, index);
+ (underflowFrameStack) = ccall getUnderflowFrameStack(stack, offsetWords);
if (underflowFrameStack == NULL) (likely: True) {
- // ccall debugBelch("advanceStackFrameIterzh - last frame \n");
newStack = NULL;
- newIndex = NULL;
+ newOffsetWords = NULL;
hasNext = NULL;
} else {
- // ccall debugBelch("advanceStackFrameIterzh - underflow frame \n");
newStack = underflowFrameStack;
- newIndex = NULL;
+ newOffsetWords = NULL;
hasNext = 1;
}
}
@@ -56,38 +44,35 @@ advanceStackFrameIterzh (P_ stack, W_ index) {
#if DEBUG
if(hasNext > 0) {
P_ nextClosure;
- nextClosure = StgStack_sp(stack) + WDS(index);
+ nextClosure = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(nextClosure));
-// ccall checkSTACK(stack);
}
#endif
- // ccall debugBelch("advanceStackFrameIterzh - stack %p, newStack %p, frameSize %ul, newIdex %ul, hasNext %ul, stackBottom %p\n", stack, newStack, frameSize, newIndex, hasNext, stackBottom);
- return (newStack, newIndex, hasNext);
+ return (newStack, newOffsetWords, hasNext);
}
-derefStackWordzh (P_ stack, W_ index) {
+derefStackWordzh (P_ stack, W_ offsetWords) {
P_ sp;
sp = StgStack_sp(stack);
- return (W_[sp + WDS(index)]);
+ return (W_[sp + WDS(offsetWords)]);
}
-getInfoTableTypezh (P_ stack, W_ index) {
+getInfoTableTypezh (P_ stack, W_ offsetWords) {
P_ p, info;
- p = StgStack_sp(stack) + WDS(index);
+ p = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(p));
info = %INFO_PTR(p);
W_ type;
type = TO_W_(%INFO_TYPE(%STD_INFO(info)));
- // ccall debugBelch("getInfoTableTypezh - stack %p , index %ul, closure ptr p %p, info ptr %p, itbl type %ul\n", stack, index, p, info, type);
return (type);
}
-getSmallBitmapzh(P_ stack, W_ index) {
+getSmallBitmapzh(P_ stack, W_ offsetWords) {
P_ c;
- c = StgStack_sp(stack) + WDS(index);
+ c = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
W_ bitmap, size, specialType;
@@ -97,9 +82,9 @@ getSmallBitmapzh(P_ stack, W_ index) {
return (bitmap, size);
}
-getRetSmallSpecialTypezh(P_ stack, W_ index) {
+getRetSmallSpecialTypezh(P_ stack, W_ offsetWords) {
P_ c;
- c = StgStack_sp(stack) + WDS(index);
+ c = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
W_ specialType;
@@ -108,9 +93,9 @@ getRetSmallSpecialTypezh(P_ stack, W_ index) {
return (specialType);
}
-getRetFunSmallBitmapzh(P_ stack, W_ index) {
+getRetFunSmallBitmapzh(P_ stack, W_ offsetWords) {
P_ c;
- c = StgStack_sp(stack) + WDS(index);
+ c = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
W_ bitmap, size, specialType;
@@ -120,10 +105,10 @@ getRetFunSmallBitmapzh(P_ stack, W_ index) {
return (bitmap, size);
}
-getLargeBitmapzh(P_ stack, W_ index){
+getLargeBitmapzh(P_ stack, W_ offsetWords){
P_ c, stgArrBytes;
W_ size;
- c = StgStack_sp(stack) + WDS(index);
+ c = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
(stgArrBytes) = ccall getLargeBitmaps(MyCapability(), c);
@@ -132,10 +117,10 @@ getLargeBitmapzh(P_ stack, W_ index){
return (stgArrBytes, size);
}
-getBCOLargeBitmapzh(P_ stack, W_ index){
+getBCOLargeBitmapzh(P_ stack, W_ offsetWords){
P_ c, stgArrBytes;
W_ size;
- c = StgStack_sp(stack) + WDS(index);
+ c = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
(stgArrBytes) = ccall getBCOLargeBitmaps(MyCapability(), c);
@@ -144,10 +129,10 @@ getBCOLargeBitmapzh(P_ stack, W_ index){
return (stgArrBytes, size);
}
-getRetFunLargeBitmapzh(P_ stack, W_ index){
+getRetFunLargeBitmapzh(P_ stack, W_ offsetWords){
P_ c, stgArrBytes;
W_ size;
- c = StgStack_sp(stack) + WDS(index);
+ c = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
(stgArrBytes) = ccall getRetFunLargeBitmaps(MyCapability(), c);
@@ -156,19 +141,21 @@ getRetFunLargeBitmapzh(P_ stack, W_ index){
return (stgArrBytes, size);
}
-// TODO: Use generalized version unpackClosureReferencedByFramezh with offset=0
-unpackClosureFromStackFramezh(P_ stack, W_ index){
- P_ closurePtr, closurePtrPrime;
- // TODO: Rename closurePtr -> closurePtrAddr
- closurePtr = (StgStack_sp(stack) + WDS(index));
- closurePtrPrime = P_[closurePtr];
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtrPrime));
- jump stg_unpackClosurezh(closurePtrPrime);
+unpackClosureFromStackFramezh(P_ stack, W_ offsetWords){
+ jump unpackClosureReferencedByFramezh(0, stack, offsetWords);
}
-getUpdateFrameTypezh(P_ stack, W_ index){
+unpackClosureReferencedByFramezh(W_ offsetBytes, P_ stack, W_ offsetWords){
+ P_ closurePtrAddr, closurePtr;
+ closurePtrAddr = (StgStack_sp(stack) + WDS(offsetWords) + offsetBytes);
+ closurePtr = P_[closurePtrAddr];
+ ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
+ jump stg_unpackClosurezh(closurePtr);
+}
+
+getUpdateFrameTypezh(P_ stack, W_ offsetWords){
P_ c;
- c = StgStack_sp(stack) + WDS(index);
+ c = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
W_ type;
@@ -176,18 +163,9 @@ getUpdateFrameTypezh(P_ stack, W_ index){
return (type);
}
-unpackClosureReferencedByFramezh(W_ offset, P_ stack, W_ index){
- P_ closurePtr, closurePtrPrime;
- // TODO: Rename closurePtr -> closurePtrAddr
- closurePtr = (StgStack_sp(stack) + WDS(index) + offset);
- closurePtrPrime = P_[closurePtr];
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtrPrime));
- jump stg_unpackClosurezh(closurePtrPrime);
-}
-
-getCatchFrameExceptionsBlockedzh(P_ stack, W_ index){
+getCatchFrameExceptionsBlockedzh(P_ stack, W_ offsetWords){
P_ closurePtr;
- closurePtr = (StgStack_sp(stack) + WDS(index));
+ closurePtr = (StgStack_sp(stack) + WDS(offsetWords));
ASSERT(LOOKS_LIKE_CLOSURE_PTR(closurePtr));
W_ exceptions_blocked;
@@ -195,16 +173,15 @@ getCatchFrameExceptionsBlockedzh(P_ stack, W_ index){
return (exceptions_blocked);
}
-// TODO: Rename: index -> wordOffset, offset -> byteOffset
-getWordzh(P_ stack, W_ index, W_ offset){
+getWordzh(P_ stack, W_ offsetWords, W_ offsetBytes){
P_ wordAddr;
- wordAddr = (StgStack_sp(stack) + WDS(index) + offset);
+ wordAddr = (StgStack_sp(stack) + WDS(offsetWords) + offsetBytes);
return (W_[wordAddr]);
}
-getUnderflowFrameNextChunkzh(P_ stack, W_ index){
+getUnderflowFrameNextChunkzh(P_ stack, W_ offsetWords){
P_ closurePtr, closurePtrPrime, updateePtr;
- closurePtr = (StgStack_sp(stack) + WDS(index));
+ closurePtr = (StgStack_sp(stack) + WDS(offsetWords));
ASSERT(LOOKS_LIKE_CLOURE_PTR(closurePtr));
P_ next_chunk;
@@ -213,9 +190,9 @@ getUnderflowFrameNextChunkzh(P_ stack, W_ index){
return (next_chunk);
}
-getRetFunTypezh(P_ stack, W_ index){
+getRetFunTypezh(P_ stack, W_ offsetWords){
P_ c;
- c = StgStack_sp(stack) + WDS(index);
+ c = StgStack_sp(stack) + WDS(offsetWords);
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
W_ type;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97d24436e041791748bc07ca6b7f66180454e95c...bc141e9b3e8bbfebc745d0b7d2c69dc34473df9f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/97d24436e041791748bc07ca6b7f66180454e95c...bc141e9b3e8bbfebc745d0b7d2c69dc34473df9f
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/20230121/60e1b258/attachment-0001.html>
More information about the ghc-commits
mailing list