[Git][ghc/ghc][wip/ghc-debug] 3 commits: Fix types in tests
Sven Tennie
gitlab at gitlab.haskell.org
Sun Aug 9 16:50:50 UTC 2020
Sven Tennie pushed to branch wip/ghc-debug at Glasgow Haskell Compiler / GHC
Commits:
edc224a6 by Sven Tennie at 2020-08-09T17:53:09+02:00
Fix types in tests
Use `Ptr ()` instead of `Word` to communicate that addresses/pointers
are meant.
- - - - -
8bbec88b by Sven Tennie at 2020-08-09T18:23:39+02:00
Cleanup
- - - - -
c3aae56d by Sven Tennie at 2020-08-09T18:50:18+02:00
Introduce LiftedClosure
This is a representation for closures that do not have a represantation
in the Haskell language. I.e. things like TSOs.
- - - - -
4 changed files:
- libraries/ghc-heap/GHC/Exts/Heap.hs
- libraries/ghc-heap/tests/list_threads_and_misc_roots.hs
- libraries/ghc-heap/tests/prof_info.hs
- libraries/ghc-heap/tests/tso_and_stack_closures.hs
Changes:
=====================================
libraries/ghc-heap/GHC/Exts/Heap.hs
=====================================
@@ -24,6 +24,7 @@ values, i.e. to investigate sharing and lazy evaluation.
module GHC.Exts.Heap (
-- * Closure types
Closure
+ , LiftedClosure
, GenClosure(..)
, ClosureType(..)
, PrimType(..)
@@ -90,6 +91,12 @@ import Foreign
foreign import ccall "isEndTsoQueue" isEndTsoQueue_c :: Addr# -> Bool
+-- | Some closures (e.g.TSOs) don't have corresponding types to represent them in Haskell.
+-- So when we have a pointer to such closure that we want to inspect, we `unsafeCoerce` it
+-- into the following `LiftedClosure` lifted type (could be any lifted type) so that the
+-- appropriate `instance HasHeapRep (a :: TYPE 'LiftedRep)` is used to decode the closure.
+data LiftedClosure
+
class HasHeapRep (a :: TYPE rep) where
-- | Decode a closure to it's heap representation ('GenClosure').
@@ -97,8 +104,7 @@ class HasHeapRep (a :: TYPE rep) where
-- containing a thunk or an evaluated heap object. Outside it can be a
-- 'Word' for "raw" usage of pointers.
--- TODO: Remove Show constraint
- getClosureDataX :: Show b =>
+ getClosureDataX ::
(forall c . c -> IO (Ptr StgInfoTable, [Word], [b]))
-- ^ Helper function to get info table, memory and pointers of the
-- closure. The order of @[b]@ is significant and determined by
@@ -188,8 +194,7 @@ getClosureData = getClosureDataX getClosureRaw
--
-- For most use cases 'getClosureData' is an easier to use alternative.
--- TODO: Remove Show constraint
-getClosureX :: forall a b. Show b =>
+getClosureX :: forall a b.
(forall c . c -> IO (Ptr StgInfoTable, [Word], [b]))
-- ^ Helper function to get info table, memory and pointers of the
-- closure
@@ -347,10 +352,6 @@ getClosureX get_closure_raw x = do
allocaArray (length wds) (\ptr -> do
pokeArray ptr wds
--- TODO: remove prints
- print $ "tso ptr : " ++ show ptr
- print $ "tso pts : " ++ show pts
- print $ "tso info table : " ++ show itbl
-- TODO: Does this work? I.e. do we emit EndTSOQueues?
if isEndTsoQueue_c (unpackPtr ptr) then
pure $ EndTSOQueue { info = itbl }
=====================================
libraries/ghc-heap/tests/list_threads_and_misc_roots.hs
=====================================
@@ -7,12 +7,6 @@ import Control.Concurrent
import GHC.Exts.Heap
import GHC.Exts
-
--- Invent a type to bypass the type constraints of getClosureData.
--- Infact this will be a Word#, that is directly given to unpackClosure#
--- (which is a primop that expects a pointer to a closure).
-data FoolClosure
-
foreign import ccall safe "list_threads_and_misc_roots_c.h listThreadsAndMiscRoots"
listThreadsAndMiscRoots_c :: IO ()
@@ -20,13 +14,13 @@ foreign import ccall safe "list_threads_and_misc_roots_c.h getTSOCount"
getTSOCount_c :: IO Int
foreign import ccall safe "list_threads_and_misc_roots_c.h getTSOs"
- getTSOs_c :: IO (Ptr Word)
+ getTSOs_c :: IO (Ptr (Ptr ()))
foreign import ccall safe "list_threads_and_misc_roots_c.h getMiscRootsCount"
getMiscRootsCount_c :: IO Int
foreign import ccall safe "list_threads_and_misc_roots_c.h getMiscRoots"
- getMiscRoots_c :: IO (Ptr Word)
+ getMiscRoots_c :: IO (Ptr (Ptr ()))
main :: IO ()
main = do
@@ -50,13 +44,13 @@ main = do
return ()
-createClosure :: Word -> IO (GenClosure Box)
+createClosure :: Ptr () -> IO (GenClosure Box)
createClosure tsoPtr = do
- let wPtr = unpackWord# tsoPtr
- getClosureData ((unsafeCoerce# wPtr) :: FoolClosure)
+ let addr = unpackAddr# tsoPtr
+ getClosureData ((unsafeCoerce# addr) :: LiftedClosure)
-unpackWord# :: Word -> Word#
-unpackWord# (W# w#) = w#
+unpackAddr# :: Ptr () -> Addr#
+unpackAddr# (Ptr addr) = addr
assertEqual :: (Show a, Eq a) => a -> a -> IO ()
assertEqual a b
=====================================
libraries/ghc-heap/tests/prof_info.hs
=====================================
@@ -14,18 +14,13 @@ import Data.List (find)
#include "rts/Constants.h"
foreign import ccall unsafe "create_tso.h create_tso"
- c_create_tso:: IO Word
-
--- Invent a type to bypass the type constraints of getClosureData.
--- Infact this will be a Word#, that is directly given to unpackClosure#
--- (which is a primop that expects a pointer to a closure).
-data FoolStgTSO
+ c_create_tso:: IO (Ptr ())
createTSOClosure :: IO (GenClosure Box)
createTSOClosure = do
ptr <- {-# SCC "MyCostCentre" #-} c_create_tso
- let wPtr = unpackWord# ptr
- getClosureData ((unsafeCoerce# wPtr) :: FoolStgTSO)
+ let addr = unpackAddr# ptr
+ getClosureData ((unsafeCoerce# addr) :: LiftedClosure)
-- We can make some assumptions about the - otherwise dynamic - properties of
-- StgTSO and StgStack, because a new, non-running TSO is created with
@@ -50,8 +45,8 @@ main = do
assertEqual (cc_link myCostCentre) Nothing
Nothing -> error "MyCostCentre not found!"
-unpackWord# :: Word -> Word#
-unpackWord# (W# w#) = w#
+unpackAddr# :: Ptr () -> Addr#
+unpackAddr# (Ptr addr) = addr
linkedCostCentres :: Maybe CostCentre -> [CostCentre]
linkedCostCentres Nothing = []
=====================================
libraries/ghc-heap/tests/tso_and_stack_closures.hs
=====================================
@@ -11,12 +11,7 @@ import GHC.Word
#include "rts/Constants.h"
foreign import ccall unsafe "create_tso.h create_tso"
- c_create_tso:: IO Word
-
--- Invent a type to bypass the type constraints of getClosureData.
--- Infact this will be a Word#, that is directly given to unpackClosure#
--- (which is a primop that expects a pointer to a closure).
-data FoolStgTSO
+ c_create_tso:: IO (Ptr ())
-- We can make some assumptions about the - otherwise dynamic - properties of
-- StgTSO and StgStack, because a new, non-running TSO is created with
@@ -60,11 +55,11 @@ main = do
createTSOClosure :: IO (GenClosure Box)
createTSOClosure = do
ptr <- c_create_tso
- let wPtr = unpackWord# ptr
- getClosureData ((unsafeCoerce# wPtr) :: FoolStgTSO)
+ let addr = unpackAddr# ptr
+ getClosureData ((unsafeCoerce# addr) :: LiftedClosure)
-unpackWord# :: Word -> Word#
-unpackWord# (W# w#) = w#
+unpackAddr# :: Ptr () -> Addr#
+unpackAddr# (Ptr addr) = addr
assertEqual :: (Show a, Eq a) => a -> a -> IO ()
assertEqual a b
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea0717a6e3f90ab40715438a9ef85b080156460...c3aae56da68ed36bd043ee1840c582492ccc3ae0
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7ea0717a6e3f90ab40715438a9ef85b080156460...c3aae56da68ed36bd043ee1840c582492ccc3ae0
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/20200809/5b3fbd4b/attachment-0001.html>
More information about the ghc-commits
mailing list