Export StgTSO fields with the help of hsc2hs

libraries/ghc-heap/GHC/Exts/Heap.hs

@@ -58,6 +58,7 @@ import GHC.Exts.Heap.InfoTableProf
 import GHC.Exts.Heap.InfoTable
 #endif
 import GHC.Exts.Heap.Utils
+import GHC.Exts.Heap.FFIClosures
 
 import Control.Monad
 import Data.Bits
@@ -66,6 +67,8 @@ import GHC.Exts
 import GHC.Int
 import GHC.Word
 
+import Foreign
+
 #include "ghcconfig.h"
 
 class HasHeapRep (a :: TYPE rep) where
@@ -290,6 +293,18 @@ getClosureX get_closure_raw x = do
             unless (length pts == 6) $
                 fail $ "Expected 6 ptr arguments to TSO, found "
                         ++ show (length pts)
+
+            threadId' <- allocaArray (length wds) (\ptr -> do
+                pokeArray ptr wds
+                id <- peekStgThreadID ptr
+                return id
+                )
+            alloc_limit' <- allocaArray (length wds) (\ptr -> do
+                pokeArray ptr wds
+                alloc_limit <- peekAllocLimit ptr
+                return alloc_limit
+                )
+
             pure $ TSOClosure
                 { info = itbl
                 , _link = (pts !! 0)
@@ -298,6 +313,8 @@ getClosureX get_closure_raw x = do
                 , trec = (pts !! 3)
                 , blocked_exceptions = (pts !! 4)
                 , bq = (pts !! 5)
+                , threadId = threadId'
+                , alloc_limit = alloc_limit'
                 }
         STACK -> do
             unless (length pts >= 1) $

libraries/ghc-heap/GHC/Exts/Heap/Closures.hs

@@ -266,12 +266,16 @@ data GenClosure b
   -- | StgTSO
   | TSOClosure
       { info :: !StgInfoTable
+      -- pointers
       , _link :: !b
       , global_link :: !b
       , tsoStack :: !b -- ^ stackobj from StgTSO
       , trec :: !b
       , blocked_exceptions :: !b
       , bq :: !b
+      -- values
+      , threadId :: Word64
+      , alloc_limit :: Int64
       }
 
   | StackClosure

libraries/ghc-heap/GHC/Exts/Heap/FFIClosures.hsc

+module GHC.Exts.Heap.FFIClosures where
+
+#include "Rts.h"
+
+import Prelude
+import Foreign
+import Foreign.Ptr
+import Data.Int
+
+import GHC.Exts.Heap.Closures
+
+peekStgThreadID :: Ptr a -> IO Word64
+peekStgThreadID ptr = do
+    id <- (#peek struct StgTSO_, id) ptr
+    return id
+
+peekAllocLimit :: Ptr a -> IO Int64
+peekAllocLimit ptr = do
+    alloc_limit <- (#peek struct StgTSO_, alloc_limit) ptr
+    return alloc_limit

libraries/ghc-heap/ghc-heap.cabal.in

@@ -39,3 +39,4 @@ library
                     GHC.Exts.Heap.InfoTable.Types
                     GHC.Exts.Heap.InfoTableProf
                     GHC.Exts.Heap.Utils
+                    GHC.Exts.Heap.FFIClosures

rts/Heap.c

@@ -223,6 +223,13 @@ static StgWord collect_pointers(StgClosure *closure, StgWord size, StgClosure *p
 
             ASSERT((StgClosure *)((StgTSO *)closure)->bq != NULL);
             ptrs[nptrs++] = (StgClosure *)((StgTSO *)closure)->bq;
+
+            int threadId = ((StgTSO *)closure)->id;
+            debugBelch("threadId : %u", threadId);
+
+            int alloc_limit = ((StgTSO *)closure)->alloc_limit;
+            debugBelch("alloc_limit : %d", alloc_limit);
+
             break;
         case STACK:
             ptrs[nptrs++] = (StgClosure *)((StgStack *)closure)->sp;