[Git][ghc/ghc][wip/local-symbols-2] 3 commits: Move this_module into NCGConfig
Ben Gamari
gitlab at gitlab.haskell.org
Tue Nov 10 01:39:52 UTC 2020
Ben Gamari pushed to branch wip/local-symbols-2 at Glasgow Haskell Compiler / GHC
Commits:
fcca924a by Ben Gamari at 2020-11-09T20:39:43-05:00
Move this_module into NCGConfig
In various places in the NCG we need the Module currently being
compiled. Let's move this into the environment instead of chewing threw
another register.
- - - - -
a8fc9b7c by Ben Gamari at 2020-11-09T20:39:43-05:00
codeGen: Produce local symbols for module-internal functions
It turns out that some important native debugging/profiling tools (e.g.
perf) rely only on symbol tables for function name resolution (as
opposed to using DWARF DIEs). However, previously GHC would emit
temporary symbols (e.g. `.La42b`) to identify module-internal
entities. Such symbols are dropped during linking and therefore not
visible to runtime tools (in addition to having rather un-helpful unique
names). For instance, `perf report` would often end up attributing all
cost to the libc `frame_dummy` symbol since Haskell code was no covered
by any proper symbol (see #17605).
We now rather follow the model of C compilers and emit
descriptively-named local symbols for module internal things. Since this
will increase object file size this behavior can be disabled with the
`-fno-expose-internal-symbols` flag.
With this `perf record` can finally be used against Haskell executables.
Even more, with `-g3` `perf annotate` provides inline source code.
- - - - -
221aa82a by Ben Gamari at 2020-11-09T20:39:43-05:00
Enable -fexpose-internal-symbols when debug level >=2
This seems like a reasonable default as the object file size increases
by around 5%.
- - - - -
12 changed files:
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/Config.hs
- compiler/GHC/CmmToAsm/Monad.hs
- compiler/GHC/CmmToAsm/PIC.hs
- compiler/GHC/CmmToAsm/X86/Ppr.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- docs/users_guide/debug-info.rst
- docs/users_guide/phases.rst
- testsuite/tests/regalloc/regalloc_unit_tests.hs
Changes:
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -118,6 +118,7 @@ module GHC.Cmm.CLabel (
LabelStyle (..),
pprDebugCLabel,
pprCLabel,
+ ppInternalProcLabel,
-- * Others
dynamicLinkerLabelInfo,
@@ -1082,8 +1083,8 @@ isLocalCLabel this_mod lbl =
-- that data resides in a DLL or not. [Win32 only.]
-- @labelDynamic@ returns @True@ if the label is located
-- in a DLL, be it a data reference or not.
-labelDynamic :: NCGConfig -> Module -> CLabel -> Bool
-labelDynamic config this_mod lbl =
+labelDynamic :: NCGConfig -> CLabel -> Bool
+labelDynamic config lbl =
case lbl of
-- is the RTS in a DLL or not?
RtsLabel _ ->
@@ -1136,6 +1137,7 @@ labelDynamic config this_mod lbl =
externalDynamicRefs = ncgExternalDynamicRefs config
platform = ncgPlatform config
os = platformOS platform
+ this_mod = ncgThisModule config
this_unit = toUnitId (moduleUnit this_mod)
@@ -1359,6 +1361,39 @@ pprCLabel platform sty lbl =
CmmLabel _ _ fs CmmRet -> maybe_underscore $ ftext fs <> text "_ret"
CmmLabel _ _ fs CmmClosure -> maybe_underscore $ ftext fs <> text "_closure"
+-- Note [Internal proc labels]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- Some tools (e.g. the `perf` utility on Linux) rely on the symbol table
+-- for resolution of function names. To help these tools we provide the
+-- (enabled by default) -fexpose-all-symbols flag which causes GHC to produce
+-- symbols even for symbols with are internal to a module (although such
+-- symbols will have only local linkage).
+--
+-- Note that these labels are *not* referred to by code. They are strictly for
+-- diagnostics purposes.
+--
+-- To avoid confusion, it is desireable to add a module-qualifier to the
+-- symbol name. However, the Name type's Internal constructor doesn't carry
+-- knowledge of the current Module. Consequently, we have to pass this around
+-- explicitly.
+
+-- | Generate a label for a procedure internal to a module (if
+-- 'Opt_ExposeAllSymbols' is enabled).
+-- See Note [Internal proc labels].
+ppInternalProcLabel :: Module -- ^ the current module
+ -> CLabel
+ -> Maybe SDoc -- ^ the internal proc label
+ppInternalProcLabel this_mod (IdLabel nm _ flavour)
+ | isInternalName nm
+ = Just
+ $ text "_" <> ppr this_mod
+ <> char '_'
+ <> ztext (zEncodeFS (occNameFS (occName nm)))
+ <> char '_'
+ <> pprUniqueAlways (getUnique nm)
+ <> ppIdFlavor flavour
+ppInternalProcLabel _ _ = Nothing
ppIdFlavor :: IdLabelInfo -> SDoc
ppIdFlavor x = pp_cSEP <> case x of
=====================================
compiler/GHC/Cmm/Info/Build.hs
=====================================
@@ -946,7 +946,8 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
topSRT <- get
let
- config = initNCGConfig dflags
+ this_mod = thisModule topSRT
+ config = initNCGConfig dflags this_mod
profile = targetProfile dflags
platform = profilePlatform profile
srtMap = moduleSRTMap topSRT
@@ -1019,8 +1020,6 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
in
state{ moduleSRTMap = srt_map }
- this_mod = thisModule topSRT
-
allStaticData =
all (\(CAFLabel clbl) -> Set.member clbl static_data) caf_lbls
@@ -1048,7 +1047,7 @@ oneSRT dflags staticFuns lbls caf_lbls isCAF cafs static_data = do
-- when dynamic linking is used we cannot guarantee that the offset
-- between the SRT and the info table will fit in the offset field.
-- Consequently we build a singleton SRT in this case.
- not (labelDynamic config this_mod lbl)
+ not (labelDynamic config lbl)
-- MachO relocations can't express offsets between compilation units at
-- all, so we are always forced to build a singleton SRT in this case.
=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -152,11 +152,11 @@ nativeCodeGen :: forall a . DynFlags -> Module -> ModLocation -> Handle -> UniqS
-> Stream IO RawCmmGroup a
-> IO a
nativeCodeGen dflags this_mod modLoc h us cmms
- = let config = initNCGConfig dflags
+ = let config = initNCGConfig dflags this_mod
platform = ncgPlatform config
nCG' :: ( OutputableP Platform statics, Outputable jumpDest, Instruction instr)
=> NcgImpl statics instr jumpDest -> IO a
- nCG' ncgImpl = nativeCodeGen' dflags config this_mod modLoc ncgImpl h us cmms
+ nCG' ncgImpl = nativeCodeGen' dflags config modLoc ncgImpl h us cmms
in case platformArch platform of
ArchX86 -> nCG' (X86.ncgX86 config)
ArchX86_64 -> nCG' (X86.ncgX86_64 config)
@@ -221,20 +221,20 @@ See also Note [What is this unwinding business?] in "GHC.Cmm.DebugBlock".
nativeCodeGen' :: (OutputableP Platform statics, Outputable jumpDest, Instruction instr)
=> DynFlags
-> NCGConfig
- -> Module -> ModLocation
+ -> ModLocation
-> NcgImpl statics instr jumpDest
-> Handle
-> UniqSupply
-> Stream IO RawCmmGroup a
-> IO a
-nativeCodeGen' dflags config this_mod modLoc ncgImpl h us cmms
+nativeCodeGen' dflags config modLoc ncgImpl h us cmms
= do
-- BufHandle is a performance hack. We could hide it inside
-- Pretty if it weren't for the fact that we do lots of little
-- printDocs here (in order to do codegen in constant space).
bufh <- newBufHandle h
let ngs0 = NGS [] [] [] [] [] [] emptyUFM mapEmpty
- (ngs, us', a) <- cmmNativeGenStream dflags config this_mod modLoc ncgImpl bufh us
+ (ngs, us', a) <- cmmNativeGenStream dflags config modLoc ncgImpl bufh us
cmms ngs0
_ <- finishNativeGen dflags config modLoc bufh us' ngs
return a
@@ -300,7 +300,7 @@ finishNativeGen dflags config modLoc bufh@(BufHandle _ _ h) us ngs
cmmNativeGenStream :: (OutputableP Platform statics, Outputable jumpDest, Instruction instr)
=> DynFlags
-> NCGConfig
- -> Module -> ModLocation
+ -> ModLocation
-> NcgImpl statics instr jumpDest
-> BufHandle
-> UniqSupply
@@ -308,7 +308,7 @@ cmmNativeGenStream :: (OutputableP Platform statics, Outputable jumpDest, Instru
-> NativeGenAcc statics instr
-> IO (NativeGenAcc statics instr, UniqSupply, a)
-cmmNativeGenStream dflags config this_mod modLoc ncgImpl h us cmm_stream ngs
+cmmNativeGenStream dflags config modLoc ncgImpl h us cmm_stream ngs
= do r <- Stream.runStream cmm_stream
case r of
Left a ->
@@ -330,7 +330,7 @@ cmmNativeGenStream dflags config this_mod modLoc ncgImpl h us cmm_stream ngs
dbgMap = debugToMap ndbgs
-- Generate native code
- (ngs',us') <- cmmNativeGens dflags config this_mod modLoc ncgImpl h
+ (ngs',us') <- cmmNativeGens dflags config modLoc ncgImpl h
dbgMap us cmms ngs 0
-- Link native code information into debug blocks
@@ -345,7 +345,7 @@ cmmNativeGenStream dflags config this_mod modLoc ncgImpl h us cmm_stream ngs
let ngs'' = ngs' { ngs_debug = ngs_debug ngs' ++ ldbgs, ngs_labels = [] }
return (us', ngs'')
- cmmNativeGenStream dflags config this_mod modLoc ncgImpl h us'
+ cmmNativeGenStream dflags config modLoc ncgImpl h us'
cmm_stream' ngs''
where ncglabel = text "NCG"
@@ -356,7 +356,7 @@ cmmNativeGens :: forall statics instr jumpDest.
(OutputableP Platform statics, Outputable jumpDest, Instruction instr)
=> DynFlags
-> NCGConfig
- -> Module -> ModLocation
+ -> ModLocation
-> NcgImpl statics instr jumpDest
-> BufHandle
-> LabelMap DebugBlock
@@ -366,7 +366,7 @@ cmmNativeGens :: forall statics instr jumpDest.
-> Int
-> IO (NativeGenAcc statics instr, UniqSupply)
-cmmNativeGens dflags config this_mod modLoc ncgImpl h dbgMap = go
+cmmNativeGens dflags config modLoc ncgImpl h dbgMap = go
where
go :: UniqSupply -> [RawCmmDecl]
-> NativeGenAcc statics instr -> Int
@@ -379,7 +379,7 @@ cmmNativeGens dflags config this_mod modLoc ncgImpl h dbgMap = go
let fileIds = ngs_dwarfFiles ngs
(us', fileIds', native, imports, colorStats, linearStats, unwinds)
<- {-# SCC "cmmNativeGen" #-}
- cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap
+ cmmNativeGen dflags modLoc ncgImpl us fileIds dbgMap
cmm count
-- Generate .file directives for every new file that has been
@@ -433,7 +433,7 @@ emitNativeCode dflags config h sdoc = do
cmmNativeGen
:: forall statics instr jumpDest. (Instruction instr, OutputableP Platform statics, Outputable jumpDest)
=> DynFlags
- -> Module -> ModLocation
+ -> ModLocation
-> NcgImpl statics instr jumpDest
-> UniqSupply
-> DwarfFiles
@@ -449,7 +449,7 @@ cmmNativeGen
, LabelMap [UnwindPoint] -- unwinding information for blocks
)
-cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
+cmmNativeGen dflags modLoc ncgImpl us fileIds dbgMap cmm count
= do
let config = ncgConfig ncgImpl
let platform = ncgPlatform config
@@ -467,7 +467,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
-- cmm to cmm optimisations
let (opt_cmm, imports) =
{-# SCC "cmmToCmm" #-}
- cmmToCmm config this_mod fixed_cmm
+ cmmToCmm config fixed_cmm
dumpIfSet_dyn dflags
Opt_D_dump_opt_cmm "Optimised Cmm" FormatCMM
@@ -479,7 +479,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
-- generate native code from cmm
let ((native, lastMinuteImports, fileIds', nativeCfgWeights), usGen) =
{-# SCC "genMachCode" #-}
- initUs us $ genMachCode config this_mod modLoc
+ initUs us $ genMachCode config modLoc
(cmmTopCodeGen ncgImpl)
fileIds dbgMap opt_cmm cmmCfg
@@ -914,7 +914,7 @@ apply_mapping ncgImpl ufm (CmmProc info lbl live (ListGraph blocks))
genMachCode
:: NCGConfig
- -> Module -> ModLocation
+ -> ModLocation
-> (RawCmmDecl -> NatM [NatCmmDecl statics instr])
-> DwarfFiles
-> LabelMap DebugBlock
@@ -927,9 +927,9 @@ genMachCode
, CFG
)
-genMachCode config this_mod modLoc cmmTopCodeGen fileIds dbgMap cmm_top cmm_cfg
+genMachCode config modLoc cmmTopCodeGen fileIds dbgMap cmm_top cmm_cfg
= do { initial_us <- getUniqueSupplyM
- ; let initial_st = mkNatM_State initial_us 0 config this_mod
+ ; let initial_st = mkNatM_State initial_us 0 config
modLoc fileIds dbgMap cmm_cfg
(new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
final_delta = natm_delta final_st
@@ -966,10 +966,10 @@ Ideas for other things we could do (put these in Hoopl please!):
temp assignments, and certain assigns to mem...)
-}
-cmmToCmm :: NCGConfig -> Module -> RawCmmDecl -> (RawCmmDecl, [CLabel])
-cmmToCmm _ _ top@(CmmData _ _) = (top, [])
-cmmToCmm config this_mod (CmmProc info lbl live graph)
- = runCmmOpt config this_mod $
+cmmToCmm :: NCGConfig -> RawCmmDecl -> (RawCmmDecl, [CLabel])
+cmmToCmm _ top@(CmmData _ _) = (top, [])
+cmmToCmm config (CmmProc info lbl live graph)
+ = runCmmOpt config (ncgThisModule config) $
do blocks' <- mapM cmmBlockConFold (toBlockList graph)
return $ CmmProc info lbl live (ofBlockList (g_entry graph) blocks')
@@ -986,24 +986,23 @@ pattern OptMResult x y = (# x, y #)
data OptMResult a = OptMResult !a ![CLabel] deriving (Functor)
#endif
-newtype CmmOptM a = CmmOptM (NCGConfig -> Module -> [CLabel] -> OptMResult a)
+newtype CmmOptM a = CmmOptM (NCGConfig -> [CLabel] -> OptMResult a)
deriving (Functor)
instance Applicative CmmOptM where
- pure x = CmmOptM $ \_ _ imports -> OptMResult x imports
+ pure x = CmmOptM $ \_ imports -> OptMResult x imports
(<*>) = ap
instance Monad CmmOptM where
(CmmOptM f) >>= g =
- CmmOptM $ \config this_mod imports0 ->
- case f config this_mod imports0 of
+ CmmOptM $ \config imports0 ->
+ case f config imports0 of
OptMResult x imports1 ->
case g x of
- CmmOptM g' -> g' config this_mod imports1
+ CmmOptM g' -> g' config imports1
instance CmmMakeDynamicReferenceM CmmOptM where
addImport = addImportCmmOpt
- getThisModule = CmmOptM $ \_ this_mod imports -> OptMResult this_mod imports
addImportCmmOpt :: CLabel -> CmmOptM ()
addImportCmmOpt lbl = CmmOptM $ \_ _ imports -> OptMResult () (lbl:imports)
@@ -1011,9 +1010,9 @@ addImportCmmOpt lbl = CmmOptM $ \_ _ imports -> OptMResult () (lbl:imports)
getCmmOptConfig :: CmmOptM NCGConfig
getCmmOptConfig = CmmOptM $ \config _ imports -> OptMResult config imports
-runCmmOpt :: NCGConfig -> Module -> CmmOptM a -> (a, [CLabel])
-runCmmOpt config this_mod (CmmOptM f) =
- case f config this_mod [] of
+runCmmOpt :: NCGConfig -> CmmOptM a -> (a, [CLabel])
+runCmmOpt config (CmmOptM f) =
+ case f config [] of
OptMResult result imports -> (result, imports)
cmmBlockConFold :: CmmBlock -> CmmOptM CmmBlock
@@ -1143,9 +1142,10 @@ cmmExprNative referenceKind expr = do
-> return other
-- | Initialize the native code generator configuration from the DynFlags
-initNCGConfig :: DynFlags -> NCGConfig
-initNCGConfig dflags = NCGConfig
+initNCGConfig :: DynFlags -> Module -> NCGConfig
+initNCGConfig dflags this_mod = NCGConfig
{ ncgPlatform = targetPlatform dflags
+ , ncgThisModule = this_mod
, ncgAsmContext = initSDocContext dflags (PprCode AsmStyle)
, ncgProcAlignment = cmmProcAlignment dflags
, ncgExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags
@@ -1190,5 +1190,6 @@ initNCGConfig dflags = NCGConfig
, ncgDwarfEnabled = debugLevel dflags > 0
, ncgDwarfUnwindings = debugLevel dflags >= 1
, ncgDwarfStripBlockInfo = debugLevel dflags < 2 -- We strip out block information when running with -g0 or -g1.
+ , ncgExposeInternalSymbols = gopt Opt_ExposeInternalSymbols dflags
}
=====================================
compiler/GHC/CmmToAsm/Config.hs
=====================================
@@ -11,12 +11,14 @@ import GHC.Prelude
import GHC.Platform
import GHC.Cmm.Type (Width(..))
import GHC.CmmToAsm.CFG.Weight
+import GHC.Unit.Module (Module)
import GHC.Utils.Outputable
-- | Native code generator configuration
data NCGConfig = NCGConfig
{ ncgPlatform :: !Platform -- ^ Target platform
, ncgAsmContext :: !SDocContext -- ^ Context for ASM code generation
+ , ncgThisModule :: !Module -- ^ The name of the module we are currently compiling
, ncgProcAlignment :: !(Maybe Int) -- ^ Mandatory proc alignment
, ncgExternalDynamicRefs :: !Bool -- ^ Generate code to link against dynamic libraries
, ncgPIC :: !Bool -- ^ Enable Position-Independent Code
@@ -37,6 +39,7 @@ data NCGConfig = NCGConfig
, ncgDwarfEnabled :: !Bool -- ^ Enable Dwarf generation
, ncgDwarfUnwindings :: !Bool -- ^ Enable unwindings
, ncgDwarfStripBlockInfo :: !Bool -- ^ Strip out block information from generated Dwarf
+ , ncgExposeInternalSymbols :: !Bool -- ^ Expose symbol table entries for internal symbols
}
-- | Return Word size
=====================================
compiler/GHC/CmmToAsm/Monad.hs
=====================================
@@ -80,6 +80,8 @@ data NcgImpl statics instr jumpDest = NcgImpl {
canShortcut :: instr -> Maybe jumpDest,
shortcutStatics :: (BlockId -> Maybe jumpDest) -> statics -> statics,
shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr,
+ -- | 'Module' is only for printing internal labels. See Note [Internal proc
+ -- labels] in CLabel.
pprNatCmmDecl :: NatCmmDecl statics instr -> SDoc,
maxSpillSlots :: Int,
allocatableRegs :: [RealReg],
@@ -107,7 +109,6 @@ data NatM_State
natm_imports :: [(CLabel)],
natm_pic :: Maybe Reg,
natm_config :: NCGConfig,
- natm_this_module :: Module,
natm_modloc :: ModLocation,
natm_fileid :: DwarfFiles,
natm_debug_map :: LabelMap DebugBlock,
@@ -125,9 +126,9 @@ newtype NatM result = NatM (NatM_State -> (result, NatM_State))
unNat :: NatM a -> NatM_State -> (a, NatM_State)
unNat (NatM a) = a
-mkNatM_State :: UniqSupply -> Int -> NCGConfig -> Module -> ModLocation ->
+mkNatM_State :: UniqSupply -> Int -> NCGConfig -> ModLocation ->
DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State
-mkNatM_State us delta config this_mod
+mkNatM_State us delta config
= \loc dwf dbg cfg ->
NatM_State
{ natm_us = us
@@ -135,7 +136,6 @@ mkNatM_State us delta config this_mod
, natm_imports = []
, natm_pic = Nothing
, natm_config = config
- , natm_this_module = this_mod
, natm_modloc = loc
, natm_fileid = dwf
, natm_debug_map = dbg
@@ -198,10 +198,11 @@ getCfgWeights = NatM $ \ st -> (ncgCfgWeights (natm_config st), st)
setDeltaNat :: Int -> NatM ()
setDeltaNat delta = NatM $ \ st -> ((), st {natm_delta = delta})
-
getThisModuleNat :: NatM Module
-getThisModuleNat = NatM $ \ st -> (natm_this_module st, st)
+getThisModuleNat = NatM $ \ st -> (ncgThisModule $ natm_config st, st)
+instance HasModule NatM where
+ getModule = getThisModuleNat
addImportNat :: CLabel -> NatM ()
addImportNat imp
=====================================
compiler/GHC/CmmToAsm/PIC.hs
=====================================
@@ -65,7 +65,6 @@ import GHC.Cmm
import GHC.Cmm.CLabel
import GHC.Types.Basic
-import GHC.Unit.Module
import GHC.Utils.Outputable
import GHC.Utils.Panic
@@ -95,11 +94,9 @@ data ReferenceKind
class Monad m => CmmMakeDynamicReferenceM m where
addImport :: CLabel -> m ()
- getThisModule :: m Module
instance CmmMakeDynamicReferenceM NatM where
addImport = addImportNat
- getThisModule = getThisModuleNat
cmmMakeDynamicReference
:: CmmMakeDynamicReferenceM m
@@ -113,13 +110,11 @@ cmmMakeDynamicReference config referenceKind lbl
= return $ CmmLit $ CmmLabel lbl -- already processed it, pass through
| otherwise
- = do this_mod <- getThisModule
- let platform = ncgPlatform config
+ = do let platform = ncgPlatform config
case howToAccessLabel
config
(platformArch platform)
(platformOS platform)
- this_mod
referenceKind lbl of
AccessViaStub -> do
@@ -208,7 +203,7 @@ data LabelAccessStyle
| AccessViaSymbolPtr
| AccessDirectly
-howToAccessLabel :: NCGConfig -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle
+howToAccessLabel :: NCGConfig -> Arch -> OS -> ReferenceKind -> CLabel -> LabelAccessStyle
-- Windows
-- In Windows speak, a "module" is a set of objects linked into the
@@ -231,7 +226,7 @@ howToAccessLabel :: NCGConfig -> Arch -> OS -> Module -> ReferenceKind -> CLabel
-- into the same .exe file. In this case we always access symbols directly,
-- and never use __imp_SYMBOL.
--
-howToAccessLabel config _ OSMinGW32 this_mod _ lbl
+howToAccessLabel config _arch OSMinGW32 _kind lbl
-- Assume all symbols will be in the same PE, so just access them directly.
| not (ncgExternalDynamicRefs config)
@@ -239,7 +234,7 @@ howToAccessLabel config _ OSMinGW32 this_mod _ lbl
-- If the target symbol is in another PE we need to access it via the
-- appropriate __imp_SYMBOL pointer.
- | labelDynamic config this_mod lbl
+ | labelDynamic config lbl
= AccessViaSymbolPtr
-- Target symbol is in the same PE as the caller, so just access it directly.
@@ -255,9 +250,9 @@ howToAccessLabel config _ OSMinGW32 this_mod _ lbl
-- It is always possible to access something indirectly,
-- even when it's not necessary.
--
-howToAccessLabel config arch OSDarwin this_mod DataReference lbl
+howToAccessLabel config arch OSDarwin DataReference lbl
-- data access to a dynamic library goes via a symbol pointer
- | labelDynamic config this_mod lbl
+ | labelDynamic config lbl
= AccessViaSymbolPtr
-- when generating PIC code, all cross-module data references must
@@ -276,21 +271,21 @@ howToAccessLabel config arch OSDarwin this_mod DataReference lbl
| otherwise
= AccessDirectly
-howToAccessLabel config arch OSDarwin this_mod JumpReference lbl
+howToAccessLabel config arch OSDarwin JumpReference lbl
-- dyld code stubs don't work for tailcalls because the
-- stack alignment is only right for regular calls.
-- Therefore, we have to go via a symbol pointer:
| arch == ArchX86 || arch == ArchX86_64
- , labelDynamic config this_mod lbl
+ , labelDynamic config lbl
= AccessViaSymbolPtr
-howToAccessLabel config arch OSDarwin this_mod _ lbl
+howToAccessLabel config arch OSDarwin _kind lbl
-- Code stubs are the usual method of choice for imported code;
-- not needed on x86_64 because Apple's new linker, ld64, generates
-- them automatically.
| arch /= ArchX86_64
- , labelDynamic config this_mod lbl
+ , labelDynamic config lbl
= AccessViaStub
| otherwise
@@ -301,7 +296,7 @@ howToAccessLabel config arch OSDarwin this_mod _ lbl
-- AIX
-- quite simple (for now)
-howToAccessLabel _config _arch OSAIX _this_mod kind _lbl
+howToAccessLabel _config _arch OSAIX kind _lbl
= case kind of
DataReference -> AccessViaSymbolPtr
CallReference -> AccessDirectly
@@ -318,7 +313,7 @@ howToAccessLabel _config _arch OSAIX _this_mod kind _lbl
-- from position independent code. It is also required from the main program
-- when dynamic libraries containing Haskell code are used.
-howToAccessLabel _ (ArchPPC_64 _) os _ kind _
+howToAccessLabel _config (ArchPPC_64 _) os kind _lbl
| osElfTarget os
= case kind of
-- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC
@@ -330,7 +325,7 @@ howToAccessLabel _ (ArchPPC_64 _) os _ kind _
-- regular calls are handled by the runtime linker
_ -> AccessDirectly
-howToAccessLabel config _ os _ _ _
+howToAccessLabel config _arch os _kind _lbl
-- no PIC -> the dynamic linker does everything for us;
-- if we don't dynamically link to Haskell code,
-- it actually manages to do so without messing things up.
@@ -339,11 +334,11 @@ howToAccessLabel config _ os _ _ _
not (ncgExternalDynamicRefs config)
= AccessDirectly
-howToAccessLabel config arch os this_mod DataReference lbl
+howToAccessLabel config arch os DataReference lbl
| osElfTarget os
= case () of
-- A dynamic label needs to be accessed via a symbol pointer.
- _ | labelDynamic config this_mod lbl
+ _ | labelDynamic config lbl
-> AccessViaSymbolPtr
-- For PowerPC32 -fPIC, we have to access even static data
@@ -369,25 +364,25 @@ howToAccessLabel config arch os this_mod DataReference lbl
-- (AccessDirectly, because we get an implicit symbol stub)
-- and calling functions from PIC code on non-i386 platforms (via a symbol stub)
-howToAccessLabel config arch os this_mod CallReference lbl
+howToAccessLabel config arch os CallReference lbl
| osElfTarget os
- , labelDynamic config this_mod lbl && not (ncgPIC config)
+ , labelDynamic config lbl && not (ncgPIC config)
= AccessDirectly
| osElfTarget os
, arch /= ArchX86
- , labelDynamic config this_mod lbl
+ , labelDynamic config lbl
, ncgPIC config
= AccessViaStub
-howToAccessLabel config _ os this_mod _ lbl
+howToAccessLabel config _arch os _kind lbl
| osElfTarget os
- = if labelDynamic config this_mod lbl
+ = if labelDynamic config lbl
then AccessViaSymbolPtr
else AccessDirectly
-- all other platforms
-howToAccessLabel config _ _ _ _ _
+howToAccessLabel config _arch _os _kind _lbl
| not (ncgPIC config)
= AccessDirectly
=====================================
compiler/GHC/CmmToAsm/X86/Ppr.hs
=====================================
@@ -90,6 +90,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
-- special case for code without info table:
pprSectionAlign config (Section Text lbl) $$
pprProcAlignment config $$
+ pprProcLabel config lbl $$
pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
vcat (map (pprBasicBlock config top_info) blocks) $$
(if ncgDwarfEnabled config
@@ -99,6 +100,7 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
Just (CmmStaticsRaw info_lbl _) ->
pprSectionAlign config (Section Text info_lbl) $$
pprProcAlignment config $$
+ pprProcLabel config lbl $$
(if platformHasSubsectionsViaSymbols platform
then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':'
else empty) $$
@@ -114,6 +116,15 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
else empty) $$
pprSizeDecl platform info_lbl
+-- | Output an internal proc label. See Note [Internal proc labels] in CLabel.
+pprProcLabel :: NCGConfig -> CLabel -> SDoc
+pprProcLabel config lbl
+ | ncgExposeInternalSymbols config
+ , Just lbl' <- ppInternalProcLabel (ncgThisModule config) lbl
+ = lbl' <> char ':'
+ | otherwise
+ = empty
+
-- | Output the ELF .size directive.
pprSizeDecl :: Platform -> CLabel -> SDoc
pprSizeDecl platform lbl
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -274,6 +274,7 @@ data GeneralFlag
-- forwards all -L flags to the collect2 command without using a
-- response file and as such breaking apart.
| Opt_SingleLibFolder
+ | Opt_ExposeInternalSymbols
| Opt_KeepCAFs
| Opt_KeepGoing
| Opt_ByteCode
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -376,7 +376,6 @@ import qualified GHC.LanguageExtensions as LangExt
-- -----------------------------------------------------------------------------
-- DynFlags
-
-- | Used to differentiate the scope an include needs to apply to.
-- We have to split the include paths to avoid accidentally forcing recursive
-- includes since -I overrides the system search paths. See #14312.
@@ -3417,6 +3416,7 @@ fFlagsDeps = [
flagSpec "error-spans" Opt_ErrorSpans,
flagSpec "excess-precision" Opt_ExcessPrecision,
flagSpec "expose-all-unfoldings" Opt_ExposeAllUnfoldings,
+ flagSpec "expose-internal-symbols" Opt_ExposeInternalSymbols,
flagSpec "external-dynamic-refs" Opt_ExternalDynamicRefs,
flagSpec "external-interpreter" Opt_ExternalInterpreter,
flagSpec "flat-cache" Opt_FlatCache,
@@ -4419,7 +4419,13 @@ setVerbosity :: Maybe Int -> DynP ()
setVerbosity mb_n = upd (\dfs -> dfs{ verbosity = mb_n `orElse` 3 })
setDebugLevel :: Maybe Int -> DynP ()
-setDebugLevel mb_n = upd (\dfs -> dfs{ debugLevel = mb_n `orElse` 2 })
+setDebugLevel mb_n =
+ upd (\dfs -> exposeSyms $ dfs{ debugLevel = n })
+ where
+ n = mb_n `orElse` 2
+ exposeSyms
+ | n > 2 = setGeneralFlag' Opt_ExposeInternalSymbols
+ | otherwise = id
data PkgDbRef
= GlobalPkgDb
=====================================
docs/users_guide/debug-info.rst
=====================================
@@ -14,6 +14,7 @@ useable by most UNIX debugging tools.
:category: debugging
:since: 7.10, numeric levels since 8.0
+ :implies: :ghc-flag:`-fexpose-internal-symbols` when ⟨n⟩ >= 2.
Emit debug information in object code. Currently only DWARF debug
information is supported on x86-64 and i386. Currently debug levels 0
=====================================
docs/users_guide/phases.rst
=====================================
@@ -720,6 +720,20 @@ Options affecting code generation
all target platforms. See the :ghc-flag:`--print-object-splitting-supported`
flag to check whether your GHC supports object splitting.
+.. ghc-flag:: -fexpose-internal-symbols
+ :shortdesc: Produce symbols for all functions, including internal functions.
+ :type: dynamic
+ :category: codegen
+
+ Request that GHC emits verbose symbol tables which include local symbols
+ for module-internal functions. These can be useful for tools like
+ :ref:`perf <https://perf.wiki.kernel.org/>` but increase object file sizes.
+ This is implied by :ghc-flag:`-g2 <-g>` and above.
+
+ :ghc-flag:`-fno-expose-internal-symbols <-fexpose-internal-symbols>`
+ suppresses all non-global symbol table entries, resulting in smaller object
+ file sizes at the expense of debuggability.
+
.. _options-linker:
Options affecting linking
=====================================
testsuite/tests/regalloc/regalloc_unit_tests.hs
=====================================
@@ -106,7 +106,7 @@ compileCmmForRegAllocStats ::
IO [( Maybe [Color.RegAllocStats (Alignment, RawCmmStatics) X86.Instr.Instr]
, Maybe [Linear.RegAllocStats])]
compileCmmForRegAllocStats dflags' cmmFile ncgImplF us = do
- let ncgImpl = ncgImplF (initNCGConfig dflags)
+ let ncgImpl = ncgImplF (initNCGConfig dflags thisMod)
hscEnv <- newHscEnv dflags
-- parse the cmm file and output any warnings or errors
@@ -126,7 +126,7 @@ compileCmmForRegAllocStats dflags' cmmFile ncgImplF us = do
-- compile and discard the generated code, returning regalloc stats
mapM (\ (count, thisCmm) ->
- cmmNativeGen dflags thisMod thisModLoc ncgImpl
+ cmmNativeGen dflags thisModLoc ncgImpl
usb dwarfFileIds dbgMap thisCmm count >>=
(\(_, _, _, _, colorStats, linearStats, _) ->
-- scrub unneeded output from cmmNativeGen
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48dd03d380ca4ff0f2a6ebf8678d1ae819858f61...221aa82af64d3d40bcd8c341c13677acb50cb476
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/48dd03d380ca4ff0f2a6ebf8678d1ae819858f61...221aa82af64d3d40bcd8c341c13677acb50cb476
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/20201109/b199c59e/attachment-0001.html>
More information about the ghc-commits
mailing list