[Git][ghc/ghc][wip/T22077] 5 commits: base: Move CString, CStringLen to GHC.Foreign
Ben Gamari (@bgamari)
gitlab at gitlab.haskell.org
Fri Aug 19 21:08:02 UTC 2022
Ben Gamari pushed to branch wip/T22077 at Glasgow Haskell Compiler / GHC
Commits:
c3697c5b by Ben Gamari at 2022-08-19T15:52:58-04:00
base: Move CString, CStringLen to GHC.Foreign
- - - - -
25a231bf by Ben Gamari at 2022-08-19T15:52:58-04:00
base: Move IPE helpers to GHC.InfoProv
- - - - -
eb7b8dab by Ben Gamari at 2022-08-19T15:52:58-04:00
rts: Refactor IPE tracing support
- - - - -
111b8492 by Ben Gamari at 2022-08-19T15:52:58-04:00
Refactor IPE initialization
Here we refactor the representation of info table provenance information
in object code to significantly reduce its size and link-time impact.
Specifically, we deduplicate strings and represent them as 32-bit
offsets into a common string table.
In addition, we rework the registration logic to eliminate allocation
from the registration path, which is run from a static initializer where
things like allocation are technically undefined behavior (although it
did previously seem to work). For similar reasons we eliminate lock
usage from registration path, instead relying on atomic CAS.
Closes #22077.
- - - - -
dafb357b by Ben Gamari at 2022-08-19T17:03:24-04:00
Separate IPE source file from span
The source file name can very often be shared across many IPE entries
whereas the source coordinates are generally unique. Separate the two to
exploit sharing of the former.
- - - - -
24 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/Parser.y
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Main.hs
- + compiler/GHC/StgToCmm/InfoTableProv.hs
- compiler/GHC/StgToCmm/Prof.hs
- compiler/ghc.cabal.in
- libraries/base/Foreign/C/String.hs
- libraries/base/GHC/Foreign.hs
- + libraries/base/GHC/InfoProv.hsc
- libraries/base/GHC/Stack/CCS.hsc
- libraries/base/GHC/Stack/CloneStack.hs
- libraries/base/base.cabal
- rts/IPE.c
- rts/IPE.h
- rts/RtsStartup.c
- rts/Trace.c
- rts/Trace.h
- rts/eventlog/EventLog.c
- rts/eventlog/EventLog.h
- rts/include/rts/IPE.h
- rts/include/stg/SMP.h
- testsuite/tests/profiling/should_run/staticcallstack001.hs
- testsuite/tests/profiling/should_run/staticcallstack002.hs
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -299,6 +299,7 @@ data ModuleLabelKind
| MLK_InitializerArray
| MLK_Finalizer String
| MLK_FinalizerArray
+ | MLK_IPEBuffer
deriving (Eq, Ord)
instance Outputable ModuleLabelKind where
@@ -306,6 +307,7 @@ instance Outputable ModuleLabelKind where
ppr (MLK_Initializer s) = text ("init__" ++ s)
ppr MLK_FinalizerArray = text "fini_arr"
ppr (MLK_Finalizer s) = text ("fini__" ++ s)
+ ppr MLK_IPEBuffer = text "ipe_buf"
isIdLabel :: CLabel -> Bool
isIdLabel IdLabel{} = True
@@ -830,10 +832,10 @@ instance OutputableP Platform InfoProvEnt where
-- Constructing Cost Center Labels
mkCCLabel :: CostCentre -> CLabel
mkCCSLabel :: CostCentreStack -> CLabel
-mkIPELabel :: InfoProvEnt -> CLabel
+mkIPELabel :: Module -> CLabel
mkCCLabel cc = CC_Label cc
mkCCSLabel ccs = CCS_Label ccs
-mkIPELabel ipe = IPE_Label ipe
+mkIPELabel mod = ModuleLabel mod MLK_IPEBuffer
mkRtsApFastLabel :: FastString -> CLabel
mkRtsApFastLabel str = RtsLabel (RtsApFast (NonDetFastString str))
@@ -1011,6 +1013,7 @@ modLabelNeedsCDecl :: ModuleLabelKind -> Bool
-- Code for finalizers and initializers are emitted in stub objects
modLabelNeedsCDecl (MLK_Initializer _) = True
modLabelNeedsCDecl (MLK_Finalizer _) = True
+modLabelNeedsCDecl MLK_IPEBuffer = True
-- The finalizer and initializer arrays are emitted in the code of the module
modLabelNeedsCDecl MLK_InitializerArray = False
modLabelNeedsCDecl MLK_FinalizerArray = False
@@ -1208,6 +1211,7 @@ moduleLabelKindType kind =
MLK_InitializerArray -> DataLabel
MLK_Finalizer _ -> CodeLabel
MLK_FinalizerArray -> DataLabel
+ MLK_IPEBuffer -> DataLabel
idInfoLabelType :: IdLabelInfo -> CLabelType
idInfoLabelType info =
=====================================
compiler/GHC/Cmm/Parser.y
=====================================
@@ -224,6 +224,7 @@ import GHC.StgToCmm.Layout hiding (ArgRep(..))
import GHC.StgToCmm.Ticky
import GHC.StgToCmm.Prof
import GHC.StgToCmm.Bind ( emitBlackHoleCode, emitUpdateFrame )
+import GHC.StgToCmm.InfoTableProv
import GHC.Cmm.Opt
import GHC.Cmm.Graph
@@ -1518,9 +1519,8 @@ parseCmmFile cmmpConfig this_mod home_unit filename = do
let fcode = do
((), cmm) <- getCmm $ unEC code "global" (initEnv (pdProfile pdConfig)) [] >> return ()
-- See Note [Mapping Info Tables to Source Positions] (IPE Maps)
- let used_info = map (cmmInfoTableToInfoProvEnt this_mod)
- (mapMaybe topInfoTable cmm)
- ((), cmm2) <- getCmm $ mapM_ emitInfoTableProv used_info
+ let used_info = map (cmmInfoTableToInfoProvEnt this_mod) (mapMaybe topInfoTable cmm)
+ ((), cmm2) <- getCmm $ emitIpeBufferListNode this_mod used_info
return (cmm ++ cmm2, used_info)
(cmm, _) = runC (cmmpStgToCmmConfig cmmpConfig) fstate st fcode
(warnings,errors) = getPsMessages pst
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -368,24 +368,17 @@ ipInitCode
:: Bool -- is Opt_InfoTableMap enabled or not
-> Platform
-> Module
- -> [InfoProvEnt]
-> CStub
-ipInitCode do_info_table platform this_mod ents
+ipInitCode do_info_table platform this_mod
| not do_info_table = mempty
- | otherwise = initializerCStub platform fn_nm decls body
+ | otherwise = initializerCStub platform fn_nm ipe_buffer_decl body
where
fn_nm = mkInitializerStubLabel this_mod "ip_init"
- decls = vcat
- $ map emit_ipe_decl ents
- ++ [emit_ipe_list ents]
- body = text "registerInfoProvList" <> parens local_ipe_list_label <> semi
- emit_ipe_decl ipe =
- text "extern InfoProvEnt" <+> ipe_lbl <> text "[];"
- where ipe_lbl = pprCLabel platform CStyle (mkIPELabel ipe)
- local_ipe_list_label = text "local_ipe_" <> ppr this_mod
- emit_ipe_list ipes =
- text "static InfoProvEnt *" <> local_ipe_list_label <> text "[] ="
- <+> braces (vcat $ [ pprCLabel platform CStyle (mkIPELabel ipe) <> comma
- | ipe <- ipes
- ] ++ [text "NULL"])
- <> semi
+
+ body = text "registerInfoProvList" <> parens (text "&" <> ipe_buffer_label) <> semi
+
+ ipe_buffer_label = pprCLabel platform CStyle (mkIPELabel this_mod)
+
+ ipe_buffer_decl =
+ text "extern IpeBufferListNode" <+> ipe_buffer_label <> text ";"
+
=====================================
compiler/GHC/Driver/Main.hs
=====================================
@@ -1830,7 +1830,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
mod_name = mkModuleName $ "Cmm$" ++ original_filename
cmm_mod = mkHomeModule home_unit mod_name
cmmpConfig = initCmmParserConfig dflags
- (cmm, ents) <- ioMsgMaybe
+ (cmm, _ents) <- ioMsgMaybe
$ do
(warns,errs,cmm) <- withTiming logger (text "ParseCmm"<+>brackets (text filename)) (\_ -> ())
$ parseCmmFile cmmpConfig cmm_mod home_unit filename
@@ -1857,7 +1857,7 @@ hscCompileCmmFile hsc_env original_filename filename output_filename = runHsc hs
Just h -> h dflags Nothing (Stream.yield cmmgroup)
let foreign_stubs _ =
- let ip_init = ipInitCode do_info_table platform cmm_mod ents
+ let ip_init = ipInitCode do_info_table platform cmm_mod
in NoStubs `appendStubC` ip_init
(_output_filename, (_stub_h_exists, stub_c_exists), _foreign_fps, _caf_infos)
=====================================
compiler/GHC/StgToCmm/InfoTableProv.hs
=====================================
@@ -0,0 +1,143 @@
+module GHC.StgToCmm.InfoTableProv (emitIpeBufferListNode) where
+
+import GHC.Prelude
+import GHC.Platform
+import GHC.Unit.Module
+import GHC.Utils.Outputable
+import GHC.Types.SrcLoc (pprUserRealSpan, srcSpanFile)
+import GHC.Data.FastString (unpackFS)
+
+import GHC.Cmm.CLabel
+import GHC.Cmm.Expr
+import GHC.Cmm.Utils
+import GHC.StgToCmm.Config
+import GHC.StgToCmm.Lit (newByteStringCLit)
+import GHC.StgToCmm.Monad
+import GHC.StgToCmm.Utils
+
+import GHC.Data.ShortText (ShortText)
+import qualified GHC.Data.ShortText as ST
+
+import qualified Data.Map.Strict as M
+import Control.Monad.Trans.State.Strict
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Builder as BSB
+import qualified Data.ByteString.Lazy as BSL
+
+emitIpeBufferListNode :: Module
+ -> [InfoProvEnt]
+ -> FCode ()
+emitIpeBufferListNode this_mod ents = do
+ cfg <- getStgToCmmConfig
+ let ctx = stgToCmmContext cfg
+ platform = stgToCmmPlatform cfg
+
+ let (cg_ipes, strtab) = flip runState emptyStringTable $ do
+ module_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (ppr this_mod)
+ mapM (toCgIPE platform ctx module_name) ents
+
+ let -- Emit the fields of an IpeBufferEntry struct.
+ toIpeBufferEntry :: CgInfoProvEnt -> [CmmLit]
+ toIpeBufferEntry cg_ipe =
+ [ CmmLabel (ipeInfoTablePtr cg_ipe)
+ , strtab_offset (ipeTableName cg_ipe)
+ , strtab_offset (ipeClosureDesc cg_ipe)
+ , strtab_offset (ipeTypeDesc cg_ipe)
+ , strtab_offset (ipeLabel cg_ipe)
+ , strtab_offset (ipeModuleName cg_ipe)
+ , strtab_offset (ipeSrcFile cg_ipe)
+ , strtab_offset (ipeSrcSpan cg_ipe)
+ , int32 0
+ ]
+
+ int n = mkIntCLit platform n
+ int32 n = CmmInt n W32
+ strtab_offset (StrTabOffset n) = int32 (fromIntegral n)
+
+ strings <- newByteStringCLit (getStringTableStrings strtab)
+ let lits = [ zeroCLit platform -- 'next' field
+ , strings -- 'strings' field
+ , int $ length cg_ipes -- 'count' field
+ ] ++ concatMap toIpeBufferEntry cg_ipes
+ emitDataLits (mkIPELabel this_mod) lits
+
+toCgIPE :: Platform -> SDocContext -> StrTabOffset -> InfoProvEnt -> State StringTable CgInfoProvEnt
+toCgIPE platform ctx module_name ipe = do
+ table_name <- lookupStringTable $ ST.pack $ renderWithContext ctx (pprCLabel platform CStyle (infoTablePtr ipe))
+ closure_desc <- lookupStringTable $ ST.pack $ show (infoProvEntClosureType ipe)
+ type_desc <- lookupStringTable $ ST.pack $ infoTableType ipe
+ let label_str = maybe "" snd (infoTableProv ipe)
+ let (src_loc_file, src_loc_span) =
+ case infoTableProv ipe of
+ Nothing -> ("", "")
+ Just (span, _) ->
+ let file = unpackFS $ srcSpanFile span
+ coords = renderWithContext ctx (pprUserRealSpan False span)
+ in (file, coords)
+ label <- lookupStringTable $ ST.pack label_str
+ src_file <- lookupStringTable $ ST.pack src_loc_file
+ src_span <- lookupStringTable $ ST.pack src_loc_span
+ return $ CgInfoProvEnt { ipeInfoTablePtr = infoTablePtr ipe
+ , ipeTableName = table_name
+ , ipeClosureDesc = closure_desc
+ , ipeTypeDesc = type_desc
+ , ipeLabel = label
+ , ipeModuleName = module_name
+ , ipeSrcFile = src_file
+ , ipeSrcSpan = src_span
+ }
+
+data CgInfoProvEnt = CgInfoProvEnt
+ { ipeInfoTablePtr :: !CLabel
+ , ipeTableName :: !StrTabOffset
+ , ipeClosureDesc :: !StrTabOffset
+ , ipeTypeDesc :: !StrTabOffset
+ , ipeLabel :: !StrTabOffset
+ , ipeModuleName :: !StrTabOffset
+ , ipeSrcFile :: !StrTabOffset
+ , ipeSrcSpan :: !StrTabOffset
+ }
+
+data StringTable = StringTable { stStrings :: DList ShortText
+ , stLength :: !Int
+ , stLookup :: !(M.Map ShortText StrTabOffset)
+ }
+
+newtype StrTabOffset = StrTabOffset Int
+
+emptyStringTable :: StringTable
+emptyStringTable =
+ StringTable { stStrings = emptyDList
+ , stLength = 0
+ , stLookup = M.empty
+ }
+
+getStringTableStrings :: StringTable -> BS.ByteString
+getStringTableStrings st =
+ BSL.toStrict $ BSB.toLazyByteString
+ $ foldMap f $ dlistToList (stStrings st)
+ where
+ f x = BSB.shortByteString (ST.contents x) `mappend` BSB.word8 0
+
+lookupStringTable :: ShortText -> State StringTable StrTabOffset
+lookupStringTable str = state $ \st ->
+ case M.lookup str (stLookup st) of
+ Just off -> (off, st)
+ Nothing ->
+ let !st' = st { stStrings = stStrings st `snoc` str
+ , stLength = stLength st + ST.byteLength str + 1
+ , stLookup = M.insert str res (stLookup st)
+ }
+ res = StrTabOffset (stLength st)
+ in (res, st')
+
+newtype DList a = DList ([a] -> [a])
+
+emptyDList :: DList a
+emptyDList = DList id
+
+snoc :: DList a -> a -> DList a
+snoc (DList f) x = DList (f . (x:))
+
+dlistToList :: DList a -> [a]
+dlistToList (DList f) = f []
=====================================
compiler/GHC/StgToCmm/Prof.hs
=====================================
@@ -11,7 +11,7 @@ module GHC.StgToCmm.Prof (
mkCCostCentre, mkCCostCentreStack,
-- infoTablePRov
- initInfoTableProv, emitInfoTableProv,
+ initInfoTableProv,
-- Cost-centre Profiling
dynProfHdr, profDynAlloc, profAlloc, staticProfHdr, initUpdFrameProf,
@@ -32,6 +32,7 @@ import GHC.Platform
import GHC.Platform.Profile
import GHC.StgToCmm.Closure
import GHC.StgToCmm.Config
+import GHC.StgToCmm.InfoTableProv
import GHC.StgToCmm.Utils
import GHC.StgToCmm.Monad
import GHC.StgToCmm.Lit
@@ -55,7 +56,6 @@ import GHC.Utils.Encoding
import Control.Monad
import Data.Char (ord)
-import Data.Bifunctor (first)
import GHC.Utils.Monad (whenM)
-----------------------------------------------------------------------------
@@ -274,9 +274,8 @@ sizeof_ccs_words platform
where
(ws,ms) = pc_SIZEOF_CostCentreStack (platformConstants platform) `divMod` platformWordSizeInBytes platform
-
+-- | Emit info-table provenance declarations
initInfoTableProv :: [CmmInfoTable] -> InfoTableProvMap -> FCode CStub
--- Emit the declarations
initInfoTableProv infos itmap
= do
cfg <- getStgToCmmConfig
@@ -284,42 +283,16 @@ initInfoTableProv infos itmap
info_table = stgToCmmInfoTableMap cfg
platform = stgToCmmPlatform cfg
this_mod = stgToCmmThisModule cfg
- -- Output the actual IPE data
- mapM_ emitInfoTableProv ents
- -- Create the C stub which initialises the IPE map
- return (ipInitCode info_table platform this_mod ents)
-
---- Info Table Prov stuff
-emitInfoTableProv :: InfoProvEnt -> FCode ()
-emitInfoTableProv ip = do
- { cfg <- getStgToCmmConfig
- ; let mod = infoProvModule ip
- ctx = stgToCmmContext cfg
- platform = stgToCmmPlatform cfg
- ; let (src, label) = maybe ("", "") (first (renderWithContext ctx . ppr)) (infoTableProv ip)
- mk_string = newByteStringCLit . utf8EncodeByteString
- ; label <- mk_string label
- ; modl <- newByteStringCLit (bytesFS $ moduleNameFS
- $ moduleName mod)
-
- ; ty_string <- mk_string (infoTableType ip)
- ; loc <- mk_string src
- ; table_name <- mk_string (renderWithContext ctx
- (pprCLabel platform CStyle (infoTablePtr ip)))
- ; closure_type <- mk_string (renderWithContext ctx
- (text $ show $ infoProvEntClosureType ip))
- ; let
- lits = [ CmmLabel (infoTablePtr ip), -- Info table pointer
- table_name, -- char *table_name
- closure_type, -- char *closure_desc -- Filled in from the InfoTable
- ty_string, -- char *ty_string
- label, -- char *label,
- modl, -- char *module,
- loc, -- char *srcloc,
- zero platform -- struct _InfoProvEnt *link
- ]
- ; emitDataLits (mkIPELabel ip) lits
- }
+
+ case ents of
+ [] -> return mempty
+ _ -> do
+ -- Emit IPE buffer
+ emitIpeBufferListNode this_mod ents
+
+ -- Create the C stub which initialises the IPE map
+ return (ipInitCode info_table platform this_mod)
+
-- ---------------------------------------------------------------------------
-- Set the current cost centre stack
=====================================
compiler/ghc.cabal.in
=====================================
@@ -615,6 +615,7 @@ Library
GHC.StgToCmm.Foreign
GHC.StgToCmm.Heap
GHC.StgToCmm.Hpc
+ GHC.StgToCmm.InfoTableProv
GHC.StgToCmm.Layout
GHC.StgToCmm.Lit
GHC.StgToCmm.Monad
=====================================
libraries/base/Foreign/C/String.hs
=====================================
@@ -110,20 +110,11 @@ import GHC.Base
import {-# SOURCE #-} GHC.IO.Encoding
import qualified GHC.Foreign as GHC
+import GHC.Foreign (CString, CStringLen)
-----------------------------------------------------------------------------
-- Strings
--- representation of strings in C
--- ------------------------------
-
--- | A C string is a reference to an array of C characters terminated by NUL.
-type CString = Ptr CChar
-
--- | A string with explicit length information in bytes instead of a
--- terminating NUL (allowing NUL characters in the middle of the string).
-type CStringLen = (Ptr CChar, Int)
-
-- exported functions
-- ------------------
--
=====================================
libraries/base/GHC/Foreign.hs
=====================================
@@ -19,6 +19,7 @@
module GHC.Foreign (
-- * C strings with a configurable encoding
+ CString, CStringLen,
-- conversion of C strings into Haskell strings
--
@@ -74,8 +75,11 @@ putDebugMsg | c_DEBUG_DUMP = debugLn
| otherwise = const (return ())
--- These definitions are identical to those in Foreign.C.String, but copied in here to avoid a cycle:
+-- | A C string is a reference to an array of C characters terminated by NUL.
type CString = Ptr CChar
+
+-- | A string with explicit length information in bytes instead of a
+-- terminating NUL (allowing NUL characters in the middle of the string).
type CStringLen = (Ptr CChar, Int)
-- exported functions
=====================================
libraries/base/GHC/InfoProv.hsc
=====================================
@@ -0,0 +1,113 @@
+{-# LANGUAGE Trustworthy #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : GHC.InfoProv
+-- Copyright : (c) The University of Glasgow 2011
+-- License : see libraries/base/LICENSE
+--
+-- Maintainer : cvs-ghc at haskell.org
+-- Stability : internal
+-- Portability : non-portable (GHC Extensions)
+--
+-- Access to GHC's info-table provenance metadata.
+--
+-- @since 4.18.0.0
+-----------------------------------------------------------------------------
+
+module GHC.InfoProv
+ ( InfoProv(..)
+ , ipLoc
+ , ipeProv
+ , whereFrom
+ -- * Internals
+ , InfoProvEnt
+ , peekInfoProv
+ ) where
+
+#include "Rts.h"
+
+import GHC.Base
+import GHC.Show
+import GHC.Ptr (Ptr(..), plusPtr, nullPtr)
+import GHC.Foreign (CString, peekCString)
+import GHC.IO.Encoding (utf8)
+import Foreign.Storable (peekByteOff)
+
+data InfoProv = InfoProv {
+ ipName :: String,
+ ipDesc :: String,
+ ipTyDesc :: String,
+ ipLabel :: String,
+ ipMod :: String,
+ ipSrcFile :: String,
+ ipSrcSpan :: String
+} deriving (Eq, Show)
+
+data InfoProvEnt
+
+ipLoc :: InfoProv -> String
+ipLoc ipe = ipSrcFile ipe ++ ":" ++ ipSrcSpan ipe
+
+getIPE :: a -> IO (Ptr InfoProvEnt)
+getIPE obj = IO $ \s ->
+ case whereFrom## obj s of
+ (## s', addr ##) -> (## s', Ptr addr ##)
+
+ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv
+ipeProv p = (#ptr InfoProvEnt, prov) p
+
+peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcFile, peekIpSrcSpan, peekIpTyDesc :: Ptr InfoProv -> IO CString
+peekIpName p = (# peek InfoProv, table_name) p
+peekIpDesc p = (# peek InfoProv, closure_desc) p
+peekIpLabel p = (# peek InfoProv, label) p
+peekIpModule p = (# peek InfoProv, module) p
+peekIpSrcFile p = (# peek InfoProv, src_file) p
+peekIpSrcSpan p = (# peek InfoProv, src_span) p
+peekIpTyDesc p = (# peek InfoProv, ty_desc) p
+
+peekInfoProv :: Ptr InfoProv -> IO InfoProv
+peekInfoProv infop = do
+ name <- peekCString utf8 =<< peekIpName infop
+ desc <- peekCString utf8 =<< peekIpDesc infop
+ tyDesc <- peekCString utf8 =<< peekIpTyDesc infop
+ label <- peekCString utf8 =<< peekIpLabel infop
+ mod <- peekCString utf8 =<< peekIpModule infop
+ file <- peekCString utf8 =<< peekIpSrcFile infop
+ span <- peekCString utf8 =<< peekIpSrcSpan infop
+ return InfoProv {
+ ipName = name,
+ ipDesc = desc,
+ ipTyDesc = tyDesc,
+ ipLabel = label,
+ ipMod = mod,
+ ipSrcFile = file,
+ ipSrcSpan = span
+ }
+
+-- | Get information about where a value originated from.
+-- This information is stored statically in a binary when `-finfo-table-map` is
+-- enabled. The source positions will be greatly improved by also enabled debug
+-- information with `-g3`. Finally you can enable `-fdistinct-constructor-tables` to
+-- get more precise information about data constructor allocations.
+--
+-- The information is collect by looking at the info table address of a specific closure and
+-- then consulting a specially generated map (by `-finfo-table-map`) to find out where we think
+-- the best source position to describe that info table arose from.
+--
+-- @since 4.16.0.0
+whereFrom :: a -> IO (Maybe InfoProv)
+whereFrom obj = do
+ ipe <- getIPE obj
+ -- The primop returns the null pointer in two situations at the moment
+ -- 1. The lookup fails for whatever reason
+ -- 2. -finfo-table-map is not enabled.
+ -- It would be good to distinguish between these two cases somehow.
+ if ipe == nullPtr
+ then return Nothing
+ else do
+ infoProv <- peekInfoProv (ipeProv ipe)
+ return $ Just infoProv
=====================================
libraries/base/GHC/Stack/CCS.hsc
=====================================
@@ -20,7 +20,6 @@ module GHC.Stack.CCS (
-- * Call stacks
currentCallStack,
whoCreated,
- whereFrom,
-- * Internals
CostCentreStack,
@@ -35,10 +34,6 @@ module GHC.Stack.CCS (
ccSrcSpan,
ccsToStrings,
renderStack,
- ipeProv,
- peekInfoProv,
- InfoProv(..),
- InfoProvEnt,
) where
import Foreign
@@ -49,7 +44,6 @@ import GHC.Ptr
import GHC.Foreign as GHC
import GHC.IO.Encoding
import GHC.List ( concatMap, reverse )
-import GHC.Show (Show)
#define PROFILING
#include "Rts.h"
@@ -142,71 +136,3 @@ renderStack :: [String] -> String
renderStack strs =
"CallStack (from -prof):" ++ concatMap ("\n "++) (reverse strs)
--- Static Closure Information
-
-data InfoProv = InfoProv {
- ipName :: String,
- ipDesc :: String,
- ipTyDesc :: String,
- ipLabel :: String,
- ipMod :: String,
- ipLoc :: String
-} deriving (Eq, Show)
-data InfoProvEnt
-
-getIPE :: a -> IO (Ptr InfoProvEnt)
-getIPE obj = IO $ \s ->
- case whereFrom## obj s of
- (## s', addr ##) -> (## s', Ptr addr ##)
-
-ipeProv :: Ptr InfoProvEnt -> Ptr InfoProv
-ipeProv p = (#ptr InfoProvEnt, prov) p
-
-peekIpName, peekIpDesc, peekIpLabel, peekIpModule, peekIpSrcLoc, peekIpTyDesc :: Ptr InfoProv -> IO CString
-peekIpName p = (# peek InfoProv, table_name) p
-peekIpDesc p = (# peek InfoProv, closure_desc) p
-peekIpLabel p = (# peek InfoProv, label) p
-peekIpModule p = (# peek InfoProv, module) p
-peekIpSrcLoc p = (# peek InfoProv, srcloc) p
-peekIpTyDesc p = (# peek InfoProv, ty_desc) p
-
-peekInfoProv :: Ptr InfoProv -> IO InfoProv
-peekInfoProv infop = do
- name <- GHC.peekCString utf8 =<< peekIpName infop
- desc <- GHC.peekCString utf8 =<< peekIpDesc infop
- tyDesc <- GHC.peekCString utf8 =<< peekIpTyDesc infop
- label <- GHC.peekCString utf8 =<< peekIpLabel infop
- mod <- GHC.peekCString utf8 =<< peekIpModule infop
- loc <- GHC.peekCString utf8 =<< peekIpSrcLoc infop
- return InfoProv {
- ipName = name,
- ipDesc = desc,
- ipTyDesc = tyDesc,
- ipLabel = label,
- ipMod = mod,
- ipLoc = loc
- }
-
--- | Get information about where a value originated from.
--- This information is stored statically in a binary when `-finfo-table-map` is
--- enabled. The source positions will be greatly improved by also enabled debug
--- information with `-g3`. Finally you can enable `-fdistinct-constructor-tables` to
--- get more precise information about data constructor allocations.
---
--- The information is collect by looking at the info table address of a specific closure and
--- then consulting a specially generated map (by `-finfo-table-map`) to find out where we think
--- the best source position to describe that info table arose from.
---
--- @since 4.16.0.0
-whereFrom :: a -> IO (Maybe InfoProv)
-whereFrom obj = do
- ipe <- getIPE obj
- -- The primop returns the null pointer in two situations at the moment
- -- 1. The lookup fails for whatever reason
- -- 2. -finfo-table-map is not enabled.
- -- It would be good to distinguish between these two cases somehow.
- if ipe == nullPtr
- then return Nothing
- else do
- infoProv <- peekInfoProv (ipeProv ipe)
- return $ Just infoProv
=====================================
libraries/base/GHC/Stack/CloneStack.hs
=====================================
@@ -28,7 +28,7 @@ import Foreign
import GHC.Conc.Sync
import GHC.Exts (Int (I#), RealWorld, StackSnapshot#, ThreadId#, Array#, sizeofArray#, indexArray#, State#, StablePtr#)
import GHC.IO (IO (..))
-import GHC.Stack.CCS (InfoProv (..), InfoProvEnt, ipeProv, peekInfoProv)
+import GHC.InfoProv (InfoProv (..), InfoProvEnt, ipLoc, ipeProv, peekInfoProv)
import GHC.Stable
-- | A frozen snapshot of the state of an execution stack.
=====================================
libraries/base/base.cabal
=====================================
@@ -222,6 +222,7 @@ Library
GHC.GHCi
GHC.GHCi.Helpers
GHC.Generics
+ GHC.InfoProv
GHC.IO
GHC.IO.Buffer
GHC.IO.BufferedIO
=====================================
rts/IPE.c
=====================================
@@ -34,17 +34,22 @@ Unfortunately, inserting into the hash map is relatively expensive. To keep
startup times low, there's a temporary data structure that is optimized for
collecting IPE lists on registration.
-It's a singly linked list of IPE list buffers. Each buffer contains space for
-126 IPE lists. This number is a bit arbitrary, but leaves a few bytes so that
-the whole structure might fit into 1024 bytes.
-
-On registering a new IPE list, there are three cases:
-
-- It's the first entry at all: Allocate a new IpeBufferListNode and make it the
- buffer's first entry.
-- The current IpeBufferListNode has space in it's buffer: Add it to the buffer.
-- The current IpeBufferListNode's buffer is full: Allocate a new one and link it
-to the previous one, making this one the new current.
+It's a singly linked list of IPE list buffers (IpeBufferListNode). These are
+emitted by the code generator, with generally one produced per module. Each
+contains an array of IPE entries and a link field (which is used to link
+buffers onto the pending list.
+
+For reasons of space efficiency, IPE entries are represented slightly
+differently in the object file than the InfoProvEnt which we ultimately expose
+to the user. Specifically, the IPEs in IpeBufferListNode are represented by
+IpeBufferEntrys, along with a corresponding string table. The string fields
+of InfoProvEnt are represented in IpeBufferEntry as 32-bit offsets into the
+string table. This allows us to halve the size of the buffer entries on
+64-bit machines while significantly reducing the number of needed
+relocations, reducing linking cost. Moreover, the code generator takes care
+to deduplicate strings when generating the string table. When we inserting a
+set of IpeBufferEntrys into the IPE hash-map we convert them to InfoProvEnts,
+which contain proper string pointers.
Building the hash map is done lazily, i.e. on first lookup or traversal. For
this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs.
@@ -52,54 +57,63 @@ this all IPE lists of all IpeBufferListNode are traversed to insert all IPEs.
After the content of a IpeBufferListNode has been inserted, it's freed.
*/
+static Mutex ipeMapLock;
static HashTable *ipeMap = NULL;
+// Accessed atomically
static IpeBufferListNode *ipeBufferList = NULL;
-static Mutex ipeMapLock;
-
-void initIpeMapLock(void) { initMutex(&ipeMapLock); }
-
-void closeIpeMapLock(void) { closeMutex(&ipeMapLock); }
+void initIpe(void) { initMutex(&ipeMapLock); }
+
+void exitIpe(void) { closeMutex(&ipeMapLock); }
+
+static InfoProvEnt ipeBufferEntryToIpe(const IpeBufferListNode *node, const IpeBufferEntry *ent)
+{
+ const char *strings = node->string_table;
+ return (InfoProvEnt) {
+ .info = ent->info,
+ .prov = {
+ .table_name = &strings[ent->table_name],
+ .closure_desc = &strings[ent->closure_desc],
+ .ty_desc = &strings[ent->ty_desc],
+ .label = &strings[ent->label],
+ .module = &strings[ent->module_name],
+ .src_file = &strings[ent->src_file],
+ .src_span = &strings[ent->src_span]
+ }
+ };
+}
-void dumpIPEToEventLog(void) {
#if defined(TRACING)
- ACQUIRE_LOCK(&ipeMapLock);
+static void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED,
+ const void *value) {
+ InfoProvEnt *ipe = (InfoProvEnt *)value;
+ traceIPE(ipe);
+}
- IpeBufferListNode *cursor = ipeBufferList;
+void dumpIPEToEventLog(void) {
+ // Dump pending entries
+ IpeBufferListNode *cursor = RELAXED_LOAD(&ipeBufferList);
while (cursor != NULL) {
- for (int i = 0; i < cursor->count; i++) {
- for (InfoProvEnt **ipeList = cursor->buffer[i]; *ipeList != NULL;
- ipeList++) {
- InfoProvEnt *ipe = *ipeList;
-
- traceIPE(ipe->info, ipe->prov.table_name,
- ipe->prov.closure_desc, ipe->prov.ty_desc,
- ipe->prov.label, ipe->prov.module, ipe->prov.srcloc);
- }
+ for (uint32_t i = 0; i < cursor->count; i++) {
+ const InfoProvEnt ent = ipeBufferEntryToIpe(cursor, &cursor->entries[i]);
+ traceIPE(&ent);
}
-
cursor = cursor->next;
}
+ // Dump entries already in hashmap
+ ACQUIRE_LOCK(&ipeMapLock);
if (ipeMap != NULL) {
mapHashTable(ipeMap, NULL, &traceIPEFromHashTable);
}
-
RELEASE_LOCK(&ipeMapLock);
-#endif
- return;
}
-#if defined(TRACING)
-void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED,
- const void *value) {
- InfoProvEnt *ipe = (InfoProvEnt *)value;
+#else
+
+void dumpIPEToEventLog(void) { }
- traceIPE(ipe->info, ipe->prov.table_name, ipe->prov.closure_desc,
- ipe->prov.ty_desc, ipe->prov.label, ipe->prov.module,
- ipe->prov.srcloc);
-}
#endif
/* Registering IPEs
@@ -109,50 +123,20 @@ Note [The Info Table Provenance Entry (IPE) Map].
Statically initialized IPE lists are registered at startup by a C constructor
function generated by the compiler (CodeOutput.hs) in a *.c file for each
-module.
+module. Since this is called in a static initializer we cannot rely on
+ipeMapLock; we instead use atomic CAS operations to add to the list.
A performance test for IPE registration and lookup can be found here:
https://gitlab.haskell.org/ghc/ghc/-/merge_requests/5724#note_370806
*/
-void registerInfoProvList(InfoProvEnt **ent_list) {
- // The list must be dereferenceable.
- ASSERT(ent_list[0] == NULL || ent_list[0] != NULL);
-
- // Ignore empty lists
- if (ent_list[0] == NULL) {
- return;
- }
-
- ACQUIRE_LOCK(&ipeMapLock);
-
- if (ipeBufferList == NULL) {
- ASSERT(ipeBufferList == NULL);
-
- ipeBufferList = stgMallocBytes(sizeof(IpeBufferListNode),
- "registerInfoProvList-firstNode");
- ipeBufferList->buffer[0] = ent_list;
- ipeBufferList->count = 1;
- ipeBufferList->next = NULL;
- } else {
- if (ipeBufferList->count < IPE_LIST_NODE_BUFFER_SIZE) {
- ipeBufferList->buffer[ipeBufferList->count] = ent_list;
- ipeBufferList->count = ipeBufferList->count + 1;
-
- ASSERT(ipeBufferList->next == NULL ||
- ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE);
- } else {
- IpeBufferListNode *newNode = stgMallocBytes(
- sizeof(IpeBufferListNode), "registerInfoProvList-nextNode");
- newNode->buffer[0] = ent_list;
- newNode->count = 1;
- newNode->next = ipeBufferList;
- ipeBufferList = newNode;
-
- ASSERT(ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE);
+void registerInfoProvList(IpeBufferListNode *node) {
+ while (true) {
+ IpeBufferListNode *old = RELAXED_LOAD(&ipeBufferList);
+ node->next = old;
+ if (cas_ptr((volatile void **) &ipeBufferList, old, node) == (void *) old) {
+ return;
}
}
-
- RELEASE_LOCK(&ipeMapLock);
}
InfoProvEnt *lookupIPE(const StgInfoTable *info) {
@@ -163,7 +147,8 @@ InfoProvEnt *lookupIPE(const StgInfoTable *info) {
void updateIpeMap() {
// Check if there's any work at all. If not so, we can circumvent locking,
// which decreases performance.
- if (ipeMap != NULL && ipeBufferList == NULL) {
+ IpeBufferListNode *pending = xchg_ptr((void **) &ipeBufferList, NULL);
+ if (ipeMap != NULL && pending == NULL) {
return;
}
@@ -173,23 +158,16 @@ void updateIpeMap() {
ipeMap = allocHashTable();
}
- while (ipeBufferList != NULL) {
- ASSERT(ipeBufferList->next == NULL ||
- ipeBufferList->next->count == IPE_LIST_NODE_BUFFER_SIZE);
- ASSERT(ipeBufferList->count > 0 &&
- ipeBufferList->count <= IPE_LIST_NODE_BUFFER_SIZE);
-
- IpeBufferListNode *currentNode = ipeBufferList;
-
- for (int i = 0; i < currentNode->count; i++) {
- for (InfoProvEnt **ipeList = currentNode->buffer[i];
- *ipeList != NULL; ipeList++) {
- insertHashTable(ipeMap, (StgWord)(*ipeList)->info, *ipeList);
- }
+ while (pending != NULL) {
+ IpeBufferListNode *currentNode = pending;
+ InfoProvEnt *ip_ents = stgMallocBytes(sizeof(InfoProvEnt) * currentNode->count, "updateIpeMap");
+ for (uint32_t i = 0; i < currentNode->count; i++) {
+ const IpeBufferEntry *ent = ¤tNode->entries[i];
+ ip_ents[i] = ipeBufferEntryToIpe(currentNode, ent);
+ insertHashTable(ipeMap, (StgWord) ent->info, &ip_ents[i]);
}
- ipeBufferList = currentNode->next;
- stgFree(currentNode);
+ pending = currentNode->next;
}
RELEASE_LOCK(&ipeMapLock);
=====================================
rts/IPE.h
=====================================
@@ -13,22 +13,9 @@
#include "BeginPrivate.h"
-#define IPE_LIST_NODE_BUFFER_SIZE 126
-
-typedef struct IpeBufferListNode_ {
- InfoProvEnt **buffer[IPE_LIST_NODE_BUFFER_SIZE];
- StgWord8 count;
- struct IpeBufferListNode_ *next;
-} IpeBufferListNode;
-
void dumpIPEToEventLog(void);
void updateIpeMap(void);
-void initIpeMapLock(void);
-void closeIpeMapLock(void);
-
-#if defined(TRACING)
-void traceIPEFromHashTable(void *data STG_UNUSED, StgWord key STG_UNUSED,
- const void *value);
-#endif
+void initIpe(void);
+void exitIpe(void);
#include "EndPrivate.h"
=====================================
rts/RtsStartup.c
=====================================
@@ -386,7 +386,7 @@ hs_init_ghc(int *argc, char **argv[], RtsConfig rts_config)
#if defined(PROFILING)
initProfiling();
#endif
- initIpeMapLock();
+ initIpe();
traceInitEvent(dumpIPEToEventLog);
initHeapProfiling();
@@ -611,7 +611,7 @@ hs_exit_(bool wait_foreign)
// Free threading resources
freeThreadingResources();
- closeIpeMapLock();
+ exitIpe();
}
// Flush stdout and stderr. We do this during shutdown so that it
=====================================
rts/Trace.c
=====================================
@@ -675,27 +675,22 @@ void traceHeapProfSampleString(StgWord8 profile_id,
}
}
-void traceIPE(StgInfoTable * info,
- const char *table_name,
- const char *closure_desc,
- const char *ty_desc,
- const char *label,
- const char *module,
- const char *srcloc )
+void traceIPE(const InfoProvEnt *ipe)
{
#if defined(DEBUG)
if (RtsFlags.TraceFlags.tracing == TRACE_STDERR) {
ACQUIRE_LOCK(&trace_utx);
tracePreface();
- debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s\n",
- table_name, closure_desc, ty_desc, label, module, srcloc);
+ debugBelch("IPE: table_name %s, closure_desc %s, ty_desc %s, label %s, module %s, srcloc %s:%s\n",
+ ipe->prov.table_name, ipe->prov.closure_desc, ipe->prov.ty_desc,
+ ipe->prov.label, ipe->prov.module, ipe->prov.src_file, ipe->prov.src_span);
RELEASE_LOCK(&trace_utx);
} else
#endif
if (eventlog_enabled) {
- postIPE((W_) INFO_PTR_TO_STRUCT(info), table_name, closure_desc, ty_desc, label, module, srcloc);
+ postIPE(ipe);
}
}
=====================================
rts/Trace.h
=====================================
@@ -330,13 +330,7 @@ void traceConcUpdRemSetFlush(Capability *cap);
void traceNonmovingHeapCensus(uint32_t log_blk_size,
const struct NonmovingAllocCensus *census);
-void traceIPE(StgInfoTable *info,
- const char *table_name,
- const char *closure_desc,
- const char *ty_desc,
- const char *label,
- const char *module,
- const char *srcloc );
+void traceIPE(const InfoProvEnt *ipe);
void flushTrace(void);
#else /* !TRACING */
@@ -373,7 +367,7 @@ void flushTrace(void);
#define traceTaskDelete_(taskID) /* nothing */
#define traceHeapProfBegin(profile_id) /* nothing */
#define traceHeapProfCostCentre(ccID, label, module, srcloc, is_caf) /* nothing */
-#define traceIPE(info, table_name, closure_desc, ty_desc, label, module, srcloc) /* nothing */
+#define traceIPE(ipe) /* nothing */
#define traceHeapProfSampleBegin(era) /* nothing */
#define traceHeapBioProfSampleBegin(era, time) /* nothing */
#define traceHeapProfSampleEnd(era) /* nothing */
=====================================
rts/eventlog/EventLog.c
=====================================
@@ -166,7 +166,7 @@ static inline void postWord64(EventsBuf *eb, StgWord64 i)
postWord32(eb, (StgWord32)i);
}
-static inline void postBuf(EventsBuf *eb, StgWord8 *buf, uint32_t size)
+static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size)
{
memcpy(eb->pos, buf, size);
eb->pos += size;
@@ -1411,34 +1411,37 @@ void postTickyCounterSamples(StgEntCounter *counters)
RELEASE_LOCK(&eventBufMutex);
}
#endif /* TICKY_TICKY */
-void postIPE(StgWord64 info,
- const char *table_name,
- const char *closure_desc,
- const char *ty_desc,
- const char *label,
- const char *module,
- const char *srcloc)
+void postIPE(const InfoProvEnt *ipe)
{
ACQUIRE_LOCK(&eventBufMutex);
- StgWord table_name_len = strlen(table_name);
- StgWord closure_desc_len = strlen(closure_desc);
- StgWord ty_desc_len = strlen(ty_desc);
- StgWord label_len = strlen(label);
- StgWord module_len = strlen(module);
- StgWord srcloc_len = strlen(srcloc);
+ StgWord table_name_len = strlen(ipe->prov.table_name);
+ StgWord closure_desc_len = strlen(ipe->prov.closure_desc);
+ StgWord ty_desc_len = strlen(ipe->prov.ty_desc);
+ StgWord label_len = strlen(ipe->prov.label);
+ StgWord module_len = strlen(ipe->prov.module);
+ StgWord src_file_len = strlen(ipe->prov.src_file);
+ StgWord src_span_len = strlen(ipe->prov.src_span);
+
// 8 for the info word
- // 6 for the number of strings in the payload as postString adds 1 to the length
- StgWord len = 8+table_name_len+closure_desc_len+ty_desc_len+label_len+module_len+srcloc_len+6;
+ // 1 null after each string
+ // 1 colon between src_file and src_span
+ StgWord len = 8+table_name_len+1+closure_desc_len+1+ty_desc_len+1+label_len+1+module_len+1+src_file_len+1+src_span_len+1;
ensureRoomForVariableEvent(&eventBuf, len);
postEventHeader(&eventBuf, EVENT_IPE);
postPayloadSize(&eventBuf, len);
- postWord64(&eventBuf, info);
- postString(&eventBuf, table_name);
- postString(&eventBuf, closure_desc);
- postString(&eventBuf, ty_desc);
- postString(&eventBuf, label);
- postString(&eventBuf, module);
- postString(&eventBuf, srcloc);
+ postWord64(&eventBuf, (StgWord) ipe->info);
+ postString(&eventBuf, ipe->prov.table_name);
+ postString(&eventBuf, ipe->prov.closure_desc);
+ postString(&eventBuf, ipe->prov.ty_desc);
+ postString(&eventBuf, ipe->prov.label);
+ postString(&eventBuf, ipe->prov.module);
+
+ // Manually construct the location field: "<file>:<span>\0"
+ postBuf(&eventBuf, (const StgWord8*) ipe->prov.src_file, src_file_len);
+ StgWord8 colon = ':';
+ postBuf(&eventBuf, &colon, 1);
+ postString(&eventBuf, ipe->prov.src_span);
+
RELEASE_LOCK(&eventBufMutex);
}
=====================================
rts/eventlog/EventLog.h
=====================================
@@ -190,13 +190,7 @@ void postProfSampleCostCentre(Capability *cap,
void postProfBegin(void);
#endif /* PROFILING */
-void postIPE(StgWord64 info,
- const char *table_name,
- const char *closure_desc,
- const char *ty_desc,
- const char *label,
- const char *module,
- const char *srcloc);
+void postIPE(const InfoProvEnt *ipe);
void postConcUpdRemSetFlush(Capability *cap);
void postConcMarkEnd(StgWord32 marked_obj_count);
=====================================
rts/include/rts/IPE.h
=====================================
@@ -14,18 +14,56 @@
#pragma once
typedef struct InfoProv_ {
- char *table_name;
- char *closure_desc;
- char *ty_desc;
- char *label;
- char *module;
- char *srcloc;
+ const char *table_name;
+ const char *closure_desc;
+ const char *ty_desc;
+ const char *label;
+ const char *module;
+ const char *src_file;
+ const char *src_span;
} InfoProv;
typedef struct InfoProvEnt_ {
- StgInfoTable *info;
+ const StgInfoTable *info;
InfoProv prov;
} InfoProvEnt;
-void registerInfoProvList(InfoProvEnt **cc_list);
+
+/*
+ * On-disk representation
+ */
+
+/*
+ * A byte offset into the string table.
+ * We use offsets rather than pointers as:
+ *
+ * a. they are smaller than pointers on 64-bit platforms
+ * b. they are easier on the linker since they do not need
+ * to be relocated
+ */
+typedef uint32_t StringIdx;
+
+// The size of this must be a multiple of the word size
+// to ensure correct packing.
+typedef struct {
+ const StgInfoTable *info;
+ StringIdx table_name;
+ StringIdx closure_desc;
+ StringIdx ty_desc;
+ StringIdx label;
+ StringIdx module_name;
+ StringIdx src_file;
+ StringIdx src_span;
+ uint32_t _padding;
+} IpeBufferEntry;
+
+typedef struct IpeBufferListNode_ {
+ struct IpeBufferListNode_ *next;
+ // Everything below is read-only and generated by the codegen
+ const char *string_table;
+ const StgWord count;
+ const IpeBufferEntry entries[];
+} IpeBufferListNode;
+
+void registerInfoProvList(IpeBufferListNode *node);
InfoProvEnt *lookupIPE(const StgInfoTable *info);
=====================================
rts/include/stg/SMP.h
=====================================
@@ -568,3 +568,20 @@ atomic_dec(StgVolatilePtr p)
#define VOLATILE_LOAD(p) ((StgWord)*((StgWord*)(p)))
#endif /* !THREADED_RTS */
+
+/* Helpers implemented in terms of the above */
+#if !IN_STG_CODE || IN_STGCRUN
+
+INLINE_HEADER void *
+xchg_ptr(void **p, void *w)
+{
+ return (void *) xchg((StgPtr) p, (StgWord) w);
+}
+
+INLINE_HEADER void *
+cas_ptr(volatile void **p, void *o, void *n)
+{
+ return (void *) cas((StgVolatilePtr) p, (StgWord) o, (StgWord) n);
+}
+
+#endif
=====================================
testsuite/tests/profiling/should_run/staticcallstack001.hs
=====================================
@@ -1,6 +1,6 @@
module Main where
-import GHC.Stack.CCS
+import GHC.InfoProv
data D = D Int deriving Show
=====================================
testsuite/tests/profiling/should_run/staticcallstack002.hs
=====================================
@@ -1,7 +1,7 @@
{-# LANGUAGE UnboxedTuples #-}
module Main where
-import GHC.Stack.CCS
+import GHC.InfoProv
-- Unboxed data constructors don't have info tables so there is
-- a special case to not generate distinct info tables for unboxed
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f4087e3cfe515b0222269e01e3cd74162970327...dafb357befbd39f54b2d16cff89e32845fc187ff
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8f4087e3cfe515b0222269e01e3cd74162970327...dafb357befbd39f54b2d16cff89e32845fc187ff
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/20220819/4a6dd0bb/attachment-0001.html>
More information about the ghc-commits
mailing list