Commit cb61371e authored by Ben Gamari's avatar Ben Gamari 🐢 Committed by Marge Bot

ghc-heap: Introduce closureSize

This function allows the user to compute the (non-transitive) size of a
heap object in words. The "closure" in the name is admittedly confusing
but we are stuck with this nomenclature at this point.
parent 3f2291e4
Pipeline #3622 passed with stages
in 329 minutes and 31 seconds
......@@ -3208,6 +3208,13 @@ primop UnpackClosureOp "unpackClosure#" GenPrimOp
with
out_of_line = True
primop ClosureSizeOp "closureSize#" GenPrimOp
a -> Int#
{ {\tt closureSize\# closure} returns the size of the given closure in
machine words. }
with
out_of_line = True
primop GetApStackValOp "getApStackVal#" GenPrimOp
a -> Int# -> (# Int#, b #)
with
......
......@@ -470,6 +470,7 @@ RTS_FUN_DECL(stg_readTVarIOzh);
RTS_FUN_DECL(stg_writeTVarzh);
RTS_FUN_DECL(stg_unpackClosurezh);
RTS_FUN_DECL(stg_closureSizzezh);
RTS_FUN_DECL(stg_getApStackValzh);
RTS_FUN_DECL(stg_getSparkzh);
RTS_FUN_DECL(stg_numSparkszh);
......
......@@ -13,6 +13,12 @@ module GHC.Exts.Heap.Closures (
, GenClosure(..)
, PrimType(..)
, allClosures
#if __GLASGOW_HASKELL__ >= 809
-- The closureSize# primop is unsupported on earlier GHC releases but we
-- build ghc-heap as a boot library so it must be buildable. Drop this once
-- we are guaranteed to bootstsrap with GHC >= 8.9.
, closureSize
#endif
-- * Boxes
, Box(..)
......@@ -321,3 +327,11 @@ allClosures (FunClosure {..}) = ptrArgs
allClosures (BlockingQueueClosure {..}) = [link, blackHole, owner, queue]
allClosures (OtherClosure {..}) = hvalues
allClosures _ = []
#if __GLASGOW_HASKELL__ >= 809
-- | Get the size of a closure in words.
--
-- @since 8.10.1
closureSize :: Box -> Int
closureSize (Box x) = I# (closureSize# x)
#endif
......@@ -6,3 +6,6 @@ test('heap_all',
omit_ways(['ghci', 'hpc'])
],
compile_and_run, [''])
test('closure_size',
omit_ways(['ghci', 'hpc', 'prof']),
compile_and_run, [''])
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Monad
import Type.Reflection
import GHC.Stack
import GHC.Exts.Heap.Closures
assertSize :: forall a. (HasCallStack, Typeable a)
=> a -> Int -> IO ()
assertSize !x expected = do
let !size = closureSize (asBox x)
when (size /= expected) $ do
putStrLn $ "closureSize ("++show (typeRep @a)++") == "++show size++", expected "++show expected
putStrLn $ prettyCallStack callStack
{-# NOINLINE assertSize #-}
pap :: Int -> Char -> Int
pap x _ = x
{-# NOINLINE pap #-}
main :: IO ()
main = do
assertSize 'a' 2
assertSize (Just ()) 2
assertSize (Nothing :: Maybe ()) 2
assertSize ((1,2) :: (Int,Int)) 3
assertSize ((1,2,3) :: (Int,Int,Int)) 4
assertSize (id :: Int -> Int) 1
assertSize (fst :: (Int,Int) -> Int) 1
assertSize (pap 1) 2
## 0.6.1
- Shipped with GHC 8.10.1
- Added to `GHC.Prim`:
closureSize# :: a -> Int#
## 0.6.0
- Shipped with GHC 8.8.1
......
......@@ -2041,6 +2041,13 @@ for:
return (info, dat_arr, ptrArray);
}
stg_closureSizzezh (P_ clos)
{
W_ len;
(len) = foreign "C" heap_view_closureSize(UNTAG(clos) "ptr");
return (len);
}
/* -----------------------------------------------------------------------------
Thread I/O blocking primitives
-------------------------------------------------------------------------- */
......
......@@ -631,6 +631,7 @@
SymI_HasProto(initLinker) \
SymI_HasProto(initLinker_) \
SymI_HasProto(stg_unpackClosurezh) \
SymI_HasProto(stg_closureSizzezh) \
SymI_HasProto(stg_getApStackValzh) \
SymI_HasProto(stg_getSparkzh) \
SymI_HasProto(stg_numSparkszh) \
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment