[Git][ghc/ghc][wip/ghc-debug] 2 commits: Add some haddock
Sven Tennie
gitlab at gitlab.haskell.org
Thu May 21 13:59:44 UTC 2020
Sven Tennie pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC
Commits:
00c297f8 by Sven Tennie at 2020-05-19T09:07:16+02:00
Add some haddock
- - - - -
660eedc8 by Sven Tennie at 2020-05-21T15:59:33+02:00
Decode StgStack with hsc2hs and add some haddock
- - - - -
4 changed files:
- libraries/ghc-heap/GHC/Exts/Heap.hs
- libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
- libraries/ghc-heap/GHC/Exts/Heap/FFIClosures.hsc
- rts/Heap.c
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/Heap.hs
=====================================
@@ -72,8 +72,16 @@ import Foreign
#include "ghcconfig.h"
class HasHeapRep (a :: TYPE rep) where
- getClosureDataX :: (forall c . c -> IO (Ptr StgInfoTable, [Word], [b]))
- -> a -> IO (GenClosure b)
+
+ -- | Decode a closure to it's heap representation ('GenClosure').
+ -- Inside a GHC context 'b' is usually a 'GHC.Exts.Heap.Closures.Box'
+ -- containing a thunk or an evaluated heap object. Outside it can be a
+ -- 'Word' for "raw" usage of pointers.
+ getClosureDataX ::
+ (forall c . c -> IO (Ptr StgInfoTable, [Word], [b]))
+ -- ^ Helper function to get info table, memory and pointers of the closure
+ -> a -- ^ Closure to decode
+ -> IO (GenClosure b) -- Heap representation of the closure
instance HasHeapRep (a :: TYPE 'LiftedRep) where
getClosureDataX = getClosureX
@@ -115,7 +123,11 @@ amap' f (Array i0 i _ arr#) = map g [0 .. i - i0]
where g (I# i#) = case indexArray# arr# i# of
(# e #) -> f e
-
+-- | Takes any value (closure) as parameter and returns a tuple of:
+-- * A 'Ptr' to the info table
+-- * The memory of the closure as @[Word]@
+-- * Pointers of the closure's @struct@ (in C code) in a @[Box]@.
+-- The pointers are collected in @Heap.c at .
getClosureRaw :: a -> IO (Ptr StgInfoTable, [Word], [Box])
getClosureRaw x = do
case unpackClosure# x of
@@ -307,32 +319,35 @@ getClosureX get_closure_raw x = do
, trec = (pts !! 3)
, blocked_exceptions = (pts !! 4)
, bq = (pts !! 5)
- , what_next = FFIClosures.what_next fields
- , why_blocked = FFIClosures.why_blocked fields
- , flags = FFIClosures.flags fields
- , threadId = FFIClosures.threadId fields
- , saved_errno = FFIClosures.saved_errno fields
- , dirty = FFIClosures.dirty fields
- , alloc_limit = FFIClosures.alloc_limit fields
- , tot_stack_size = FFIClosures.tot_stack_size fields
+ , what_next = FFIClosures.tso_what_next fields
+ , why_blocked = FFIClosures.tso_why_blocked fields
+ , flags = FFIClosures.tso_flags fields
+ , threadId = FFIClosures.tso_threadId fields
+ , saved_errno = FFIClosures.tso_saved_errno fields
+ , tso_dirty = FFIClosures.tso_dirty fields
+ , alloc_limit = FFIClosures.tso_alloc_limit fields
+ , tot_stack_size = FFIClosures.tso_tot_stack_size fields
}
)
STACK -> do
- unless (length pts >= 1) $
- fail $ "Expected at least 1 ptr argument to STACK, found "
+ unless (length pts == 1) $
+ fail $ "Expected 1 ptr argument to STACK, found "
++ show (length pts)
- let splitWord = rawWds !! 0
- pure $ StackClosure itbl
-#if defined(WORDS_BIGENDIAN)
- (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
- (fromIntegral splitWord)
-#else
- (fromIntegral splitWord)
- (fromIntegral $ shiftR splitWord (wORD_SIZE_IN_BITS `div` 2))
-#endif
- (pts !! 0)
- []
+ allocaArray (length wds) (\ptr -> do
+ pokeArray ptr wds
+
+ fields <- FFIClosures.peekStackFields ptr
+
+ pure $ StackClosure
+ { info = itbl
+ , size = FFIClosures.stack_size fields
+ , stack_dirty = FFIClosures.stack_dirty fields
+ , stackPointer = (pts !! 0)
+ , stack = FFIClosures.stack fields
+ , stack_marking = FFIClosures.stack_marking fields
+ }
+ )
_ ->
pure $ UnsupportedClosure itbl
=====================================
libraries/ghc-heap/GHC/Exts/Heap/Closures.hs
=====================================
@@ -260,7 +260,9 @@ data GenClosure b
, link :: !b -- ^ next weak pointer for the capability, can be NULL.
}
- -- | StgTSO
+ -- | Representation of StgTSO: A Thread State Object.
+ -- The values for 'what_next', 'why_blocked' and 'flags' are defined in
+ -- @Constants.h at .
| TSOClosure
{ info :: !StgInfoTable
-- pointers
@@ -276,16 +278,17 @@ data GenClosure b
, flags :: Word32
, threadId :: Word64
, saved_errno :: Word32
- , dirty:: Word32
+ , tso_dirty:: Word32 -- ^ non-zero => dirty
, alloc_limit :: Int64
, tot_stack_size :: Word32
}
-
+ -- Representation of StgStack: The 'tsoStack' of a 'TSOClosure'.
| StackClosure
{ info :: !StgInfoTable
- , size :: !HalfWord
- , dirty :: !HalfWord
- , stackPointer :: !b
+ , size :: !Word32 -- ^ stack size in *words*
+ , stack_dirty :: !Word8 -- ^ non-zero => dirty
+ , stack_marking :: Word8
+ , stackPointer :: !b -- ^ current stack pointer
, stack :: [Word]
}
=====================================
libraries/ghc-heap/GHC/Exts/Heap/FFIClosures.hsc
=====================================
@@ -8,16 +8,16 @@ import Foreign
-- TODO use sum type for what_next, why_blocked, flags?
data TSOFields = TSOFields {
- what_next :: Word16,
- why_blocked :: Word16,
- flags :: Word32,
+ tso_what_next :: Word16,
+ tso_why_blocked :: Word16,
+ tso_flags :: Word32,
-- Unfortunately block_info is a union without clear discriminator.
-- block_info :: TDB,
- threadId :: Word64,
- saved_errno :: Word32,
- dirty:: Word32,
- alloc_limit :: Int64,
- tot_stack_size :: Word32
+ tso_threadId :: Word64,
+ tso_saved_errno :: Word32,
+ tso_dirty:: Word32,
+ tso_alloc_limit :: Int64,
+ tso_tot_stack_size :: Word32
-- TODO StgTSOProfInfo prof is optionally included, but looks very interesting.
}
@@ -34,12 +34,36 @@ peekTSOFields ptr = do
tot_stack_size' <- (#peek struct StgTSO_, tot_stack_size) ptr
return TSOFields {
- what_next = what_next',
- why_blocked = why_blocked',
- flags = flags',
- threadId = threadId',
- saved_errno = saved_errno',
- dirty= dirty',
- alloc_limit = alloc_limit',
- tot_stack_size = tot_stack_size'
+ tso_what_next = what_next',
+ tso_why_blocked = why_blocked',
+ tso_flags = flags',
+ tso_threadId = threadId',
+ tso_saved_errno = saved_errno',
+ tso_dirty= dirty',
+ tso_alloc_limit = alloc_limit',
+ tso_tot_stack_size = tot_stack_size'
+ }
+
+data StackFields = StackFields {
+ stack_size :: Word32,
+ stack_dirty :: Word8,
+ stack_marking :: Word8,
+ stack :: [Word]
+}
+
+-- | Get non-closure fields from @StgStack_@ (@TSO.h@)
+peekStackFields :: Ptr a -> IO StackFields
+peekStackFields ptr = do
+ stack_size' <- (#peek struct StgStack_, stack_size) ptr ::IO Word32
+ dirty' <- (#peek struct StgStack_, dirty) ptr
+ marking' <- (#peek struct StgStack_, marking) ptr
+
+ let stackPtr = (#ptr struct StgStack_, stack) ptr
+ stack' <- peekArray (fromIntegral stack_size') stackPtr
+
+ return StackFields {
+ stack_size = stack_size',
+ stack_dirty = dirty',
+ stack_marking = marking',
+ stack = stack'
}
=====================================
rts/Heap.c
=====================================
@@ -226,10 +226,9 @@ static StgWord collect_pointers(StgClosure *closure, StgWord size, StgClosure *p
break;
case STACK:
+ ASSERT((StgClosure *)((StgStack *)closure)->sp != NULL);
ptrs[nptrs++] = (StgClosure *)((StgStack *)closure)->sp;
break;
-
-
case WEAK:
ptrs[nptrs++] = (StgClosure *)((StgWeak *)closure)->cfinalizers;
ptrs[nptrs++] = (StgClosure *)((StgWeak *)closure)->key;
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e78046b7c166ee69e0200dbb8d4c1f3f3f13930...660eedc8f6e039545c9b5a77ac7be5427c3f3d43
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/4e78046b7c166ee69e0200dbb8d4c1f3f3f13930...660eedc8f6e039545c9b5a77ac7be5427c3f3d43
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/20200521/6f8988c6/attachment-0001.html>
More information about the ghc-commits
mailing list