From 381cfaed98742508ef9919ec76f5b7b610514f86 Mon Sep 17 00:00:00 2001
From: Ben Gamari <ben@smart-cactus.org>
Date: Tue, 15 Aug 2023 00:48:15 -0400
Subject: [PATCH] ghc-heap: Don't expose stack dirty and marking fields
These are GC metadata and are not relevant to the end-user. Moreover,
they are unstable which makes ghc-heap harder to test than necessary.
---
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs | 2 --
libraries/ghc-heap/GHC/Exts/Stack/Decode.hs | 11 ++++-------
libraries/ghc-heap/cbits/Stack.cmm | 9 ++-------
libraries/ghc-heap/tests/stack_misc_closures.hs | 2 --
4 files changed, 6 insertions(+), 18 deletions(-)
diff --git a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
index 2d2e871da970..038829034c2d 100644
--- a/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
+++ b/libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
@@ -387,8 +387,6 @@ type StgStackClosure = GenStgStackClosure Box
data GenStgStackClosure b = GenStgStackClosure
{ ssc_info :: !StgInfoTable
, ssc_stack_size :: !Word32 -- ^ stack size in *words*
- , ssc_stack_dirty :: !Word8 -- ^ non-zero => dirty
- , ssc_stack_marking :: !Word8
, ssc_stack :: ![GenStackFrame b]
}
deriving (Foldable, Functor, Generic, Show, Traversable)
diff --git a/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs b/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
index 3218cfd01493..0c9000be790b 100644
--- a/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
+++ b/libraries/ghc-heap/GHC/Exts/Stack/Decode.hs
@@ -170,13 +170,12 @@ foreign import prim "getStackClosurezh"
foreign import prim "getStackFieldszh"
getStackFields# ::
- StackSnapshot# -> (# Word32#, Word8#, Word8# #)
+ StackSnapshot# -> Word32#
-getStackFields :: StackSnapshot# -> (Word32, Word8, Word8)
+getStackFields :: StackSnapshot# -> Word32
getStackFields stackSnapshot# =
case getStackFields# stackSnapshot# of
- (# sSize#, sDirty#, sMarking# #) ->
- (W32# sSize#, W8# sDirty#, W8# sMarking#)
+ sSize# -> W32# sSize#
-- | `StackFrameLocation` of the top-most stack frame
stackHead :: StackSnapshot# -> StackFrameLocation
@@ -409,15 +408,13 @@ decodeStack (StackSnapshot stack#) = do
info <- getInfoTableForStack stack#
case tipe info of
STACK -> do
- let (stack_size', stack_dirty', stack_marking') = getStackFields stack#
+ let stack_size' = getStackFields stack#
sfls = stackFrameLocations stack#
stack' <- mapM unpackStackFrame sfls
pure $
GenStgStackClosure
{ ssc_info = info,
ssc_stack_size = stack_size',
- ssc_stack_dirty = stack_dirty',
- ssc_stack_marking = stack_marking',
ssc_stack = stack'
}
_ -> error $ "Expected STACK closure, got " ++ show info
diff --git a/libraries/ghc-heap/cbits/Stack.cmm b/libraries/ghc-heap/cbits/Stack.cmm
index da5b882f259c..2671cf4ae2cd 100644
--- a/libraries/ghc-heap/cbits/Stack.cmm
+++ b/libraries/ghc-heap/cbits/Stack.cmm
@@ -173,15 +173,10 @@ getStackClosurezh(P_ stack, W_ offsetWords) {
return (closure);
}
-// (bits32, bits8, bits8) getStackFieldszh(StgStack* stack)
+// (bits32) getStackFieldszh(StgStack* stack)
getStackFieldszh(P_ stack){
bits32 size;
- bits8 dirty, marking;
-
size = StgStack_stack_size(stack);
- dirty = StgStack_dirty(stack);
- marking = StgStack_marking(stack);
-
- return (size, dirty, marking);
+ return (size);
}
#endif
diff --git a/libraries/ghc-heap/tests/stack_misc_closures.hs b/libraries/ghc-heap/tests/stack_misc_closures.hs
index 3110f4a9422f..3fbd367fd2df 100644
--- a/libraries/ghc-heap/tests/stack_misc_closures.hs
+++ b/libraries/ghc-heap/tests/stack_misc_closures.hs
@@ -308,8 +308,6 @@ main = do
assertEqual (tipe info_tbl) UNDERFLOW_FRAME
assertEqual (tipe (ssc_info nextChunk)) STACK
assertEqual (ssc_stack_size nextChunk) 27
- assertEqual (ssc_stack_dirty nextChunk) 0
- assertEqual (ssc_stack_marking nextChunk) 0
assertEqual (length (ssc_stack nextChunk)) 2
case head (ssc_stack nextChunk) of
RetSmall {..} ->
--
GitLab