[Git][ghc/ghc][wip/decode_cloned_stack] 5 commits: Remove trace from Decode
Sven Tennie (@supersven)
gitlab at gitlab.haskell.org
Sun Feb 19 18:46:30 UTC 2023
Sven Tennie pushed to branch wip/decode_cloned_stack at Glasgow Haskell Compiler / GHC
Commits:
940c3f5a by Sven Tennie at 2023-02-19T17:25:31+00:00
Remove trace from Decode
- - - - -
6516da47 by Sven Tennie at 2023-02-19T17:28:41+00:00
Delete belchStack()
- - - - -
c73d98ff by Sven Tennie at 2023-02-19T17:40:10+00:00
Debug.Trace in stack_misc_closures
- - - - -
33afe1f9 by Sven Tennie at 2023-02-19T17:41:48+00:00
Delete TODO
- - - - -
1b5549e1 by Sven Tennie at 2023-02-19T18:46:03+00:00
Remove known type fields
- - - - -
9 changed files:
- libraries/ghc-heap/GHC/Exts/Heap.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
- libraries/ghc-heap/cbits/Stack.c
- libraries/ghc-heap/cbits/Stack.cmm
- libraries/ghc-heap/tests/stack_misc_closures.hs
- libraries/ghc-heap/tests/stack_misc_closures_c.c
- libraries/ghci/GHCi/Message.hs
- rts/RtsSymbols.c
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/Heap.hs
=====================================
@@ -30,8 +30,6 @@ module GHC.Exts.Heap (
, PrimType(..)
, WhatNext(..)
, WhyBlocked(..)
- , UpdateFrameType(..)
- , SpecialRetSmall(..)
, RetFunType(..)
, TsoFlags(..)
, HasHeapRep(getClosureData)
@@ -168,7 +166,6 @@ getClosureDataFromHeapObject x = do
(# infoTableAddr, heapRep, pointersArray #) -> do
let infoTablePtr = Ptr infoTableAddr
ptrList = [case indexArray# pointersArray i of
--- TODO: What happens if the GC kicks in here? Is that possible? check Cmm.
(# ptr #) -> Box ptr
| I# i <- [0..I# (sizeofArray# pointersArray) - 1]
]
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -15,8 +15,6 @@ module GHC.Exts.Heap.Closures (
, WhatNext(..)
, WhyBlocked(..)
, TsoFlags(..)
- , UpdateFrameType(..)
- , SpecialRetSmall(..)
, RetFunType(..)
, allClosures
@@ -379,7 +377,6 @@ data GenClosure b
#if MIN_TOOL_VERSION_ghc(9,7,0)
| UpdateFrame
{ info :: !StgInfoTable
- , knownUpdateFrameType :: !UpdateFrameType
, updatee :: !b
}
@@ -418,7 +415,6 @@ data GenClosure b
| RetSmall
{ info :: !StgInfoTable
- , knownRetSmallType :: !SpecialRetSmall
, payload :: ![b]
}
@@ -436,7 +432,6 @@ data GenClosure b
}
| RetBCO
- -- TODO: Add pre-defined BCO closures (like knownUpdateFrameType)
{ info :: !StgInfoTable
, bco :: !b -- must be a BCOClosure
, bcoArgs :: ![b]
@@ -498,37 +493,6 @@ data GenClosure b
{ wordVal :: !Word }
deriving (Eq, Show, Generic, Functor, Foldable, Traversable)
--- TODO There are likely more. See MiscClosures.h
-data SpecialRetSmall =
- -- TODO: Shoudn't `None` be better `Maybe ...`?
- None |
- ApV |
- ApF |
- ApD |
- ApL |
- ApN |
- ApP |
- ApPP |
- ApPPP |
- ApPPPP |
- ApPPPPP |
- ApPPPPPP |
- RetV |
- RetP |
- RetN |
- RetF |
- RetD |
- RetL |
- RestoreCCCS |
- RestoreCCCSEval
- deriving (Enum, Eq, Show, Generic)
-
-data UpdateFrameType =
- NormalUpdateFrame |
- BhUpdateFrame |
- MarkedUpdateFrame
- deriving (Enum, Eq, Show, Generic, Ord)
-
data RetFunType =
ARG_GEN |
ARG_GEN_BIG |
=====================================
libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
=====================================
@@ -23,8 +23,6 @@ where
import Data.Array.Byte
import Data.Bits
import Data.Maybe
--- TODO: Remove before releasing
-import Debug.Trace
import Foreign
import GHC.Exts
import GHC.Exts.Heap.ClosureTypes
@@ -107,18 +105,6 @@ type LargeBitmapGetter = StackSnapshot# -> Word# -> State# RealWorld -> (# State
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 sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi
-
foreign import prim "getUnderflowFrameNextChunkzh" getUnderflowFrameNextChunk# :: StackSnapshot# -> Word# -> State# RealWorld -> (# State# RealWorld, StackSnapshot# #)
getUnderflowFrameNextChunk :: StackFrameIter -> IO StackSnapshot
@@ -169,21 +155,6 @@ foreign import prim "getRetFunLargeBitmapzh" getRetFunLargeBitmap# :: LargeBitma
foreign import prim "getSmallBitmapzh" getSmallBitmap# :: SmallBitmapGetter
-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 sfi = error $ "Unexpected StackFrameIter type: " ++ show sfi
-
foreign import prim "getRetFunSmallBitmapzh" getRetFunSmallBitmap# :: SmallBitmapGetter
foreign import prim "advanceStackFrameIterzh" advanceStackFrameIter# :: StackSnapshot# -> Word# -> (# StackSnapshot#, Word#, Int# #)
@@ -277,7 +248,7 @@ 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) $
+getClosure SfiClosure {..} relativeOffset =
IO $ \s ->
case getBoxedClosure#
stackSnapshot#
@@ -345,11 +316,8 @@ unpackStackFrameIter sfi@(SfiStackClosure {}) = do
}
_ -> error $ "Expected STACK closure, got " ++ show info
unpackStackFrameIter sfi@(SfiClosure {}) = do
- traceM $ "unpackStackFrameIter - sfi " ++ show sfi
info <- getInfoTable sfi
- res <- unpackStackFrameIter' info
- traceM $ "unpackStackFrameIter - unpacked " ++ show res
- pure res
+ unpackStackFrameIter' info
where
unpackStackFrameIter' :: StgInfoTable -> IO Closure
unpackStackFrameIter' info =
@@ -364,16 +332,13 @@ unpackStackFrameIter sfi@(SfiClosure {}) = do
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'
- }
+ RET_SMALL -> do
+ payload' <- decodeSmallBitmap getSmallBitmap# sfi offsetStgClosurePayload
+ pure $
+ RetSmall
+ { info = info,
+ payload = payload'
+ }
RET_BIG -> do
payload' <- decodeLargeBitmap getLargeBitmap# sfi offsetStgClosurePayload
pure $
@@ -399,11 +364,9 @@ unpackStackFrameIter sfi@(SfiClosure {}) = do
}
UPDATE_FRAME -> do
updatee' <- getClosure sfi offsetStgUpdateFrameUpdatee
- knownUpdateFrameType' <- getUpdateFrameType sfi
pure $
UpdateFrame
{ info = info,
- knownUpdateFrameType = knownUpdateFrameType',
updatee = updatee'
}
CATCH_FRAME -> do
=====================================
libraries/ghc-heap/cbits/Stack.c
=====================================
@@ -28,76 +28,9 @@ 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);
};
-StgWord getSpecialRetSmall(StgClosure *closure) {
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(closure));
- StgWord c = *(StgWord *)closure;
- if (c == (StgWord)&stg_ap_v_info) {
- return 1;
- } else if (c == (StgWord)&stg_ap_f_info) {
- return 2;
- } else if (c == (StgWord)&stg_ap_d_info) {
- return 3;
- } else if (c == (StgWord)&stg_ap_l_info) {
- return 4;
- } else if (c == (StgWord)&stg_ap_n_info) {
- return 5;
- } else if (c == (StgWord)&stg_ap_p_info) {
- return 6;
- } else if (c == (StgWord)&stg_ap_pp_info) {
- return 7;
- } else if (c == (StgWord)&stg_ap_ppp_info) {
- return 8;
- } else if (c == (StgWord)&stg_ap_pppp_info) {
- return 9;
- } else if (c == (StgWord)&stg_ap_ppppp_info) {
- return 10;
- } else if (c == (StgWord)&stg_ap_pppppp_info) {
- return 11;
- } else if (c == (StgWord)&stg_ret_v_info) {
- return 12;
- } else if (c == (StgWord)&stg_ret_p_info) {
- return 13;
- } else if (c == (StgWord)&stg_ret_n_info) {
- return 14;
- } else if (c == (StgWord)&stg_ret_f_info) {
- return 15;
- } else if (c == (StgWord)&stg_ret_d_info) {
- return 16;
- } else if (c == (StgWord)&stg_ret_l_info) {
- return 17;
-#if defined(PROFILING)
- } else if (c == (StgWord)&stg_restore_cccs_info) {
- return 18;
- } else if (c == (StgWord)&stg_restore_cccs_eval_info) {
- return 19;
-#endif
- } else {
- return 0;
- }
-}
-
-StgWord getUpdateFrameType(StgClosure *c) {
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
-
- const StgInfoTable *info = c->header.info;
- if (info == &stg_upd_frame_info) {
- return 0;
- } else if (info == &stg_bh_upd_frame_info) {
- return 1;
- } else if (info == &stg_marked_upd_frame_info) {
- return 2;
- } else {
- // Cannot do more than warn and exit.
- errorBelch("Cannot decide Update Frame type for info table %p closure %p.",
- info, c);
- stg_exit(EXIT_INTERNAL_ERROR);
- }
-}
-
StgWord getBitmapSize(StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
@@ -201,11 +134,8 @@ static StgArrBytes *largeBitmapToStgArrBytes(Capability *cap,
StgArrBytes *getLargeBitmap(Capability *cap, StgClosure *c) {
ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
- debugBelch("getLargeBitmap %p \n", c);
const StgInfoTable *info = get_itbl(c);
- debugBelch("getLargeBitmap tipe %ul \n", info->type);
StgLargeBitmap *bitmap = GET_LARGE_BITMAP(info);
- debugBelch("getLargeBitmap size %lu \n", bitmap->size);
return largeBitmapToStgArrBytes(cap, bitmap);
}
@@ -228,11 +158,6 @@ StgArrBytes *getBCOLargeBitmap(Capability *cap, StgClosure *c) {
return largeBitmapToStgArrBytes(cap, bitmap);
}
-#if defined(DEBUG)
-extern void printStack(StgStack *stack);
-void belchStack(StgStack *stack) { printStack(stack); }
-#endif
-
StgStack *getUnderflowFrameNextChunk(StgUnderflowFrame *frame) {
return frame->next_chunk;
}
=====================================
libraries/ghc-heap/cbits/Stack.cmm
=====================================
@@ -59,17 +59,6 @@ getSmallBitmapzh(P_ stack, W_ offsetWords) {
return (bitmap, size);
}
-getRetSmallSpecialTypezh(P_ stack, W_ offsetWords) {
- P_ c;
- c = StgStack_sp(stack) + WDS(offsetWords);
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
-
- W_ specialType;
- (specialType) = ccall getSpecialRetSmall(c);
-
- return (specialType);
-}
-
getRetFunSmallBitmapzh(P_ stack, W_ offsetWords) {
P_ c;
c = StgStack_sp(stack) + WDS(offsetWords);
@@ -118,16 +107,6 @@ getRetFunLargeBitmapzh(P_ stack, W_ offsetWords){
return (stgArrBytes, size);
}
-getUpdateFrameTypezh(P_ stack, W_ offsetWords){
- P_ c;
- c = StgStack_sp(stack) + WDS(offsetWords);
- ASSERT(LOOKS_LIKE_CLOSURE_PTR(c));
-
- W_ type;
- (type) = ccall getUpdateFrameType(c);
- return (type);
-}
-
getWordzh(P_ stack, W_ offsetWords, W_ offsetBytes){
P_ wordAddr;
wordAddr = (StgStack_sp(stack) + WDS(offsetWords) + WDS(offsetBytes));
=====================================
libraries/ghc-heap/tests/stack_misc_closures.hs
=====================================
@@ -13,7 +13,6 @@
module Main where
import Data.Functor
--- TODO: Remove later
import Debug.Trace
import GHC.Exts
import GHC.Exts.Stack.Decode
@@ -65,8 +64,6 @@ foreign import ccall "maxSmallBitmapBits" maxSmallBitmapBits_c :: Word
foreign import ccall "bitsInWord" bitsInWord :: Word
-foreign import ccall "belchStack" belchStack# :: StackSnapshot# -> IO ()
-
{- Test stategy
~~~~~~~~~~~~
@@ -93,20 +90,23 @@ GC isn't accidential. It's closer to the reality of decoding stacks.
N.B. the test data stack are only meant be de decoded. They are not executable
(the result would likely be a crash or non-sense.)
+
+- Due to the implementation details of the test framework, the Debug.Trace calls
+are only shown when the test fails. They are used as markers to see where the
+test fails on e.g. a segfault (where the HasCallStack constraint isn't helpful.)
-}
main :: HasCallStack => IO ()
main = do
- traceM $ "Test 1"
+ traceM "Test 1"
test any_update_frame# $
\case
UpdateFrame {..} -> do
assertEqual (tipe info) UPDATE_FRAME
- assertEqual knownUpdateFrameType NormalUpdateFrame
assertEqual 1 =<< (getWordFromBlackhole =<< getBoxedClosureData updatee)
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 2"
+ traceM "Test 2"
testSize any_update_frame# 2
- traceM $ "Test 3"
+ traceM "Test 3"
test any_catch_frame# $
\case
CatchFrame {..} -> do
@@ -114,9 +114,9 @@ main = do
assertEqual exceptions_blocked 1
assertConstrClosure 1 =<< getBoxedClosureData handler
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 4"
+ traceM "Test 4"
testSize any_catch_frame# 3
- traceM $ "Test 5"
+ traceM "Test 5"
test any_catch_stm_frame# $
\case
CatchStmFrame {..} -> do
@@ -124,20 +124,20 @@ main = do
assertConstrClosure 1 =<< getBoxedClosureData catchFrameCode
assertConstrClosure 2 =<< getBoxedClosureData handler
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 6"
+ traceM "Test 6"
testSize any_catch_stm_frame# 3
- traceM $ "Test 7"
+ traceM "Test 7"
test any_catch_retry_frame# $
\case
CatchRetryFrame {..} -> do
assertEqual (tipe info) CATCH_RETRY_FRAME
assertEqual running_alt_code 1
- assertConstrClosure 1 =<< getBoxedClosureData first_code
- assertConstrClosure 2 =<< getBoxedClosureData alt_code
+ assertConstrClosure 2 =<< getBoxedClosureData first_code
+ assertConstrClosure 3 =<< getBoxedClosureData alt_code
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 8"
+ traceM "Test 8"
testSize any_catch_retry_frame# 4
- traceM $ "Test 9"
+ traceM "Test 9"
test any_atomically_frame# $
\case
AtomicallyFrame {..} -> do
@@ -145,59 +145,55 @@ main = do
assertConstrClosure 1 =<< getBoxedClosureData atomicallyFrameCode
assertConstrClosure 2 =<< getBoxedClosureData result
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 10"
+ traceM "Test 10"
testSize any_atomically_frame# 3
- traceM $ "Test 11"
+ traceM "Test 11"
test any_ret_small_prim_frame# $
\case
RetSmall {..} -> do
assertEqual (tipe info) RET_SMALL
- assertEqual knownRetSmallType RetN
pCs <- mapM getBoxedClosureData payload
assertEqual (length pCs) 1
assertUnknownTypeWordSizedPrimitive 1 (head pCs)
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 12"
+ traceM "Test 12"
testSize any_ret_small_prim_frame# 2
- traceM $ "Test 13"
+ traceM "Test 13"
test any_ret_small_closure_frame# $
\case
RetSmall {..} -> do
assertEqual (tipe info) RET_SMALL
- assertEqual knownRetSmallType RetP
pCs <- mapM getBoxedClosureData payload
assertEqual (length pCs) 1
assertConstrClosure 1 (head pCs)
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 14"
+ traceM "Test 14"
testSize any_ret_small_closure_frame# 2
- traceM $ "Test 15"
+ traceM "Test 15"
test any_ret_small_closures_frame# $
\case
RetSmall {..} -> do
assertEqual (tipe info) RET_SMALL
- assertEqual knownRetSmallType None
pCs <- mapM getBoxedClosureData payload
assertEqual (length pCs) maxSmallBitmapBits
let wds = map getWordFromConstr01 pCs
assertEqual wds [1 .. maxSmallBitmapBits]
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 16"
+ traceM "Test 16"
testSize any_ret_small_closures_frame# (1 + fromIntegral maxSmallBitmapBits_c)
- traceM $ "Test 17"
+ traceM "Test 17"
test any_ret_small_prims_frame# $
\case
RetSmall {..} -> do
assertEqual (tipe info) RET_SMALL
- assertEqual knownRetSmallType None
pCs <- mapM getBoxedClosureData payload
assertEqual (length pCs) maxSmallBitmapBits
let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs
assertEqual wds [1 .. maxSmallBitmapBits]
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 18"
+ traceM "Test 18"
testSize any_ret_small_prims_frame# (1 + fromIntegral maxSmallBitmapBits_c)
- traceM $ "Test 19"
+ traceM "Test 19"
test any_ret_big_prims_min_frame# $
\case
RetBig {..} -> do
@@ -207,9 +203,9 @@ main = do
let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs
assertEqual wds [1 .. minBigBitmapBits]
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 20"
+ traceM "Test 20"
testSize any_ret_big_prims_min_frame# (minBigBitmapBits + 1)
- traceM $ "Test 21"
+ traceM "Test 21"
test any_ret_big_closures_min_frame# $
\case
RetBig {..} -> do
@@ -219,9 +215,9 @@ main = do
let wds = map getWordFromConstr01 pCs
assertEqual wds [1 .. minBigBitmapBits]
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 22"
+ traceM "Test 22"
testSize any_ret_big_closures_min_frame# (minBigBitmapBits + 1)
- traceM $ "Test 23"
+ traceM "Test 23"
test any_ret_big_closures_two_words_frame# $
\case
RetBig {..} -> do
@@ -232,9 +228,9 @@ main = do
let wds = map getWordFromConstr01 pCs
assertEqual wds [1 .. (fromIntegral closureCount)]
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 24"
+ traceM "Test 24"
testSize any_ret_big_closures_two_words_frame# (fromIntegral bitsInWord + 1 + 1)
- traceM $ "Test 25"
+ traceM "Test 25"
test any_ret_fun_arg_n_prim_frame# $
\case
RetFun {..} -> do
@@ -247,7 +243,7 @@ main = do
let wds = map getWordFromUnknownTypeWordSizedPrimitive pCs
assertEqual wds [1]
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 26"
+ traceM "Test 26"
test any_ret_fun_arg_gen_frame# $
\case
RetFun {..} -> do
@@ -268,9 +264,9 @@ main = do
let wds = map getWordFromConstr01 pCs
assertEqual wds [1 .. 9]
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 27"
+ traceM "Test 27"
testSize any_ret_fun_arg_gen_frame# (3 + 9)
- traceM $ "Test 28"
+ traceM "Test 28"
test any_ret_fun_arg_gen_big_frame# $
\case
RetFun {..} -> do
@@ -288,9 +284,9 @@ main = do
assertEqual (length pCs) 59
let wds = map getWordFromConstr01 pCs
assertEqual wds [1 .. 59]
- traceM $ "Test 29"
+ traceM "Test 29"
testSize any_ret_fun_arg_gen_big_frame# (3 + 59)
- traceM $ "Test 30"
+ traceM "Test 30"
test any_bco_frame# $
\case
RetBCO {..} -> do
@@ -314,9 +310,9 @@ main = do
bitmap
e -> error $ "Wrong closure type: " ++ show e
e -> error $ "Wrong closure type: " ++ show e
- traceM $ "Test 31"
+ traceM "Test 31"
testSize any_bco_frame# 3
- traceM $ "Test 32"
+ traceM "Test 32"
test any_underflow_frame# $
\case
UnderflowFrame {..} -> do
@@ -346,20 +342,15 @@ type SetupFunction = State# RealWorld -> (# State# RealWorld, StackSnapshot# #)
test :: HasCallStack => SetupFunction -> (Closure -> IO ()) -> IO ()
test setup assertion = do
- traceM $ "test - getStackSnapshot"
sn@(StackSnapshot sn#) <- getStackSnapshot setup
- traceM $ "test - sn " ++ show sn
performGC
- traceM $ "entertainGC - " ++ (entertainGC 10)
+ traceM $ "entertainGC - " ++ entertainGC 100
-- Run garbage collection now, to prevent later surprises: It's hard to debug
-- when the GC suddenly does it's work and there were bad closures or pointers.
-- Better fail early, here.
performGC
- traceM $ "test - sn' " ++ show sn
stackClosure <- getClosureData sn#
- traceM $ "test - ss" ++ show stackClosure
performGC
- traceM $ "call getBoxedClosureData"
let boxedFrames = stack stackClosure
stack <- mapM getBoxedClosureData boxedFrames
performGC
=====================================
libraries/ghc-heap/tests/stack_misc_closures_c.c
=====================================
@@ -10,10 +10,6 @@
#include "stg/MiscClosures.h"
#include "stg/Types.h"
-// TODO: Delete when development finished
-extern void printStack(StgStack *stack);
-extern void printObj(StgClosure *obj);
-
// See rts/Threads.c
#define MIN_STACK_WORDS (RESERVED_STACK_WORDS + sizeofW(StgStopFrame) + 3)
@@ -52,14 +48,13 @@ void create_any_catch_stm_frame(Capability *cap, StgStack *stack, StgWord w) {
catchF->handler = payload2;
}
-// TODO: Use `w` for running_alt_code, too.
void create_any_catch_retry_frame(Capability *cap, StgStack *stack, StgWord w) {
StgCatchRetryFrame *catchRF = (StgCatchRetryFrame *)stack->sp;
SET_HDR(catchRF, &stg_catch_retry_frame_info, CCS_SYSTEM);
- StgClosure *payload1 = rts_mkWord(cap, w);
- StgClosure *payload2 = rts_mkWord(cap, w + 1);
- catchRF->running_alt_code = 1;
+ catchRF->running_alt_code = w++;
+ StgClosure *payload1 = rts_mkWord(cap, w++);
catchRF->first_code = payload1;
+ StgClosure *payload2 = rts_mkWord(cap, w);
catchRF->alt_code = payload2;
}
@@ -369,5 +364,3 @@ StgStack *any_bco_frame(Capability *cap) {
StgStack *any_underflow_frame(Capability *cap) {
return setup(cap, sizeofW(StgUnderflowFrame), &create_any_underflow_frame);
}
-
-void belchStack(StgStack *stack) { printStack(stack); }
=====================================
libraries/ghci/GHCi/Message.hs
=====================================
@@ -476,8 +476,6 @@ instance Binary Heap.TsoFlags
#endif
#if MIN_VERSION_base(4,17,0)
-instance Binary Heap.SpecialRetSmall
-instance Binary Heap.UpdateFrameType
instance Binary Heap.RetFunType
instance Binary StackSnapshot where
=====================================
rts/RtsSymbols.c
=====================================
@@ -848,7 +848,6 @@ extern char **environ;
SymI_HasDataProto(stg_unpack_cstring_info) \
SymI_HasDataProto(stg_unpack_cstring_utf8_info) \
SymI_HasDataProto(stg_upd_frame_info) \
- SymI_HasDataProto(stg_marked_upd_frame_info) \
SymI_HasDataProto(stg_bh_upd_frame_info) \
SymI_HasProto(suspendThread) \
SymI_HasDataProto(stg_takeMVarzh) \
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8aa7ed1b081bb4acee620e43795907a97212a6d...1b5549e1c91022124f6e03dbc910c91a43a824a9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/f8aa7ed1b081bb4acee620e43795907a97212a6d...1b5549e1c91022124f6e03dbc910c91a43a824a9
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/20230219/44d53abb/attachment-0001.html>
More information about the ghc-commits
mailing list