[Git][ghc/ghc][wip/llvm-debug-info] 9 commits: Fix store comma
Serge S. Gulin (@gulin.serge)
gitlab at gitlab.haskell.org
Sun Jan 12 15:16:51 UTC 2025
Serge S. Gulin pushed to branch wip/llvm-debug-info at Glasgow Haskell Compiler / GHC
Commits:
7bb41685 by Serge S. Gulin at 2025-01-11T01:24:58+03:00
Fix store comma
- - - - -
ee3c2d5f by Serge S. Gulin at 2025-01-11T01:28:13+03:00
Subprograms is not a field of `DICompileUnit` in modern LLVM IR
- - - - -
e28ef657 by Serge S. Gulin at 2025-01-11T01:30:58+03:00
Passing location file metaId down
- - - - -
8d03b614 by Serge S. Gulin at 2025-01-11T01:33:18+03:00
Remove empty meta of subprograms `!XX = !{}`
- - - - -
d097d41e by Serge S. Gulin at 2025-01-11T01:35:39+03:00
Use root level fileMetaId instead of generation each record for subprograms
- - - - -
2b157e7d by Serge S. Gulin at 2025-01-11T01:42:48+03:00
Render debug header and pass location-based file metaId to subprograms
- - - - -
7034532c by Serge S. Gulin at 2025-01-11T02:04:13+03:00
Use compilation unit metaId to connect subprograms
- - - - -
5c94f143 by Serge S. Gulin at 2025-01-11T02:15:20+03:00
Add MetaDISubprogram unit to ppr
- - - - -
07c249c3 by Serge S. Gulin at 2025-01-12T18:03:17+03:00
Limit LLVM `Opt` optimization level to `0` when debug metadata is required
- - - - -
6 changed files:
- compiler/GHC/CmmToLlvm.hs
- compiler/GHC/CmmToLlvm/Base.hs
- compiler/GHC/CmmToLlvm/Ppr.hs
- compiler/GHC/Driver/Pipeline/Execute.hs
- compiler/GHC/Llvm/MetaData.hs
- compiler/GHC/Llvm/Ppr.hs
Changes:
=====================================
compiler/GHC/CmmToLlvm.hs
=====================================
@@ -105,8 +105,11 @@ llvmCodeGen' dflags location cfg cmm_stream
ghcInternalFunctions
cmmMetaLlvmPrelude
+ -- Debug metadata header
+ metaCUId <- debugInfoGen dflags location
+
-- Procedures
- a <- Stream.consume cmm_stream (GHC.CmmToLlvm.Base.liftUDSMT) (llvmGroupLlvmGens dflags location)
+ a <- Stream.consume cmm_stream (GHC.CmmToLlvm.Base.liftUDSMT) (llvmGroupLlvmGens dflags location metaCUId)
-- Declare aliases for forward references
decls <- generateExternDecls
@@ -116,22 +119,19 @@ llvmCodeGen' dflags location cfg cmm_stream
-- Postamble
cmmUsedLlvmGens
- -- Debug metadata
- debugInfoGen dflags location
+ -- Debug metadata for subprograms
+ cfg <- getConfig
+ metaSubs <- getMetaDecls
+ renderLlvm (ppLlvmMetas cfg metaSubs) (ppLlvmMetas cfg metaSubs)
return a
-debugInfoGen :: DynFlags -> ModLocation -> LlvmM ()
+debugInfoGen :: DynFlags -> ModLocation -> LlvmM MetaId
debugInfoGen dflags location
= do fileMeta <- getMetaUniqueId
- subprogramsMeta <- getMetaUniqueId
cuMeta <- getMetaUniqueId
dwarfVersionMeta <- getMetaUniqueId
debugInfoVersionMeta <- getMetaUniqueId
- cfg <- getConfig
- metaSubs <- getMetaDecls
- renderLlvm (ppLlvmMetas cfg metaSubs) (ppLlvmMetas cfg metaSubs)
- subprograms <- getSubprograms
let metaHeader =
[ MetaUnnamed fileMeta NotDistinct $ MetaDIFile
{ difFilename = fsLit $ fromMaybe "TODO" (ml_hs_file location)
@@ -142,10 +142,8 @@ debugInfoGen dflags location
, dicuFile = fileMeta
, dicuProducer = fsLit "ghc"
, dicuIsOptimized = llvmOptLevel dflags > 0
- , dicuSubprograms = MetaStruct $ map MetaNode subprograms
}
, MetaNamed (fsLit "llvm.dbg.cu") NotDistinct [ cuMeta ]
- , MetaUnnamed subprogramsMeta NotDistinct $ MetaStruct []
, MetaNamed (fsLit "llvm.module.flags") NotDistinct
[ dwarfVersionMeta
, debugInfoVersionMeta
@@ -161,8 +159,12 @@ debugInfoGen dflags location
, MetaVar $ LMLitVar $ LMIntLit 3 i32
]
]
+
+ cfg <- getConfig
renderLlvm (ppLlvmMetas cfg metaHeader) (ppLlvmMetas cfg metaHeader)
+ pure cuMeta
+
llvmHeader :: IsDoc doc => LlvmCgConfig -> doc
llvmHeader cfg =
let target = llvmCgLlvmTarget cfg
@@ -182,8 +184,8 @@ llvmHeader cfg =
{-# SPECIALIZE llvmHeader :: LlvmCgConfig -> SDoc #-}
{-# SPECIALIZE llvmHeader :: LlvmCgConfig -> HDoc #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
-llvmGroupLlvmGens :: DynFlags -> ModLocation -> RawCmmGroup -> LlvmM ()
-llvmGroupLlvmGens dflags location cmm = do
+llvmGroupLlvmGens :: DynFlags -> ModLocation -> MetaId -> RawCmmGroup -> LlvmM ()
+llvmGroupLlvmGens dflags location metaCUId cmm = do
let debug_map :: LabelMap DebugBlock
debug_map
| (debugLevel dflags) >= 1 = debugToMap $ cmmDebugGen location cmm
@@ -204,7 +206,7 @@ llvmGroupLlvmGens dflags location cmm = do
{-# SCC "llvm_datas_gen" #-}
cmmDataLlvmGens cdata
{-# SCC "llvm_procs_gen" #-}
- mapM_ (cmmLlvmGen debug_map) cmm
+ mapM_ (cmmLlvmGen debug_map metaCUId) cmm
-- -----------------------------------------------------------------------------
-- | Do LLVM code generation on all these Cmms data sections.
@@ -227,8 +229,8 @@ cmmDataLlvmGens statics
(pprLlvmData cfg (concat gss', concat tss))
-- | Complete LLVM code generation phase for a single top-level chunk of Cmm.
-cmmLlvmGen :: LabelMap DebugBlock -> RawCmmDecl -> LlvmM ()
-cmmLlvmGen debug_map cmm at CmmProc{} = do
+cmmLlvmGen :: LabelMap DebugBlock -> MetaId -> RawCmmDecl -> LlvmM ()
+cmmLlvmGen debug_map metaCUId cmm at CmmProc{} = do
-- rewrite assignments to global regs
platform <- getPlatform
@@ -243,11 +245,11 @@ cmmLlvmGen debug_map cmm at CmmProc{} = do
-- pretty print - print as we go, since we produce HDocs, we know
-- no nesting state needs to be maintained for the SDocs.
forM_ llvmBC (\decl -> do
- (hdoc, sdoc) <- pprLlvmCmmDecl debug_map decl
+ (hdoc, sdoc) <- pprLlvmCmmDecl debug_map decl metaCUId
renderLlvm (hdoc $$ empty) (sdoc $$ empty)
)
-cmmLlvmGen _ _ = return ()
+cmmLlvmGen _ _ _ = return ()
-- -----------------------------------------------------------------------------
-- | Generate meta data nodes
=====================================
compiler/GHC/CmmToLlvm/Base.hs
=====================================
@@ -20,7 +20,7 @@ module GHC.CmmToLlvm.Base (
markStackReg, checkStackReg,
funLookup, funInsert, getLlvmVer,
dumpIfSetLlvm, renderLlvm, markUsedVar, getUsedVars,
- addMetaDecl, getMetaDecls, addSubprogram, getSubprograms,
+ addMetaDecl, getMetaDecls,
ghcInternalFunctions, getPlatform, getConfig,
getMetaUniqueId,
@@ -290,8 +290,6 @@ data LlvmEnv = LlvmEnv
, envAliases :: UniqSet LMString -- ^ Globals that we had to alias, see [Llvm Forward References]
, envUsedVars :: [LlvmVar] -- ^ Pointers to be added to llvm.used (see @cmmUsedLlvmGens@)
, envMetaDecls :: [MetaDecl] -- ^ Metadata declarations to be included in final output
- , envSubprograms :: [MetaId] -- ^ 'MetaId's of the @DISubprogram@ metadata
- -- nodes defined in this @DICompileUnit at .
-- the following get cleared for every function (see @withClearVars@)
, envVarMap :: LlvmEnvMap -- ^ Local variables so far, with type
@@ -345,7 +343,6 @@ runLlvm logger cfg ver out us m = do
, envStackRegs = []
, envUsedVars = []
, envMetaDecls = []
- , envSubprograms = []
, envAliases = emptyUniqSet
, envVersion = ver
, envConfig = cfg
@@ -437,15 +434,6 @@ setUniqMeta f m = modifyEnv $ \env -> env { envUniqMeta = addToUFM (envUniqMeta
getUniqMeta :: Unique -> LlvmM (Maybe MetaId)
getUniqMeta s = getEnv (flip lookupUFM s . envUniqMeta)
--- | Add a @DISubprogram@ metadata declaration to the current compilation unit.
-addSubprogram :: MetaId -> MetaExpr -> LlvmM ()
-addSubprogram metaId metaExpr = do
- modifyEnv $ \env -> env { envSubprograms = metaId : envSubprograms env }
- addMetaDecl (MetaUnnamed metaId Distinct metaExpr)
-
-getSubprograms :: LlvmM [MetaId]
-getSubprograms = LlvmM $ \env -> return (envSubprograms env, env { envSubprograms = [] })
-
-- | Add a metadata declaration to the output.
addMetaDecl :: MetaDecl -> LlvmM ()
addMetaDecl x = modifyEnv $ \env -> env { envMetaDecls = x : envMetaDecls env }
=====================================
compiler/GHC/CmmToLlvm/Ppr.hs
=====================================
@@ -49,13 +49,13 @@ pprLlvmData cfg (globals, types) =
-- The HDoc we return is used to produce the final LLVM file, with the
-- SDoc being returned alongside for use when @Opt_D_dump_llvm@ is set
-- as we can't (currently) dump HDocs.
-pprLlvmCmmDecl :: LabelMap DebugBlock -> LlvmCmmDecl -> LlvmM (HDoc, SDoc)
-pprLlvmCmmDecl _ (CmmData _ lmdata) = do
+pprLlvmCmmDecl :: LabelMap DebugBlock -> LlvmCmmDecl -> MetaId -> LlvmM (HDoc, SDoc)
+pprLlvmCmmDecl _ (CmmData _ lmdata) _ = do
opts <- getConfig
return ( vcat $ map (pprLlvmData opts) lmdata
, vcat $ map (pprLlvmData opts) lmdata)
-pprLlvmCmmDecl debug_map (CmmProc (label, mb_info) entry_lbl live (ListGraph blks))
+pprLlvmCmmDecl debug_map (CmmProc (label, mb_info) entry_lbl live (ListGraph blks)) metaCUId
= do let lbl = case mb_info of
Nothing -> entry_lbl
Just (CmmStaticsRaw info_lbl _) -> info_lbl
@@ -104,18 +104,16 @@ pprLlvmCmmDecl debug_map (CmmProc (label, mb_info) entry_lbl live (ListGraph blk
, disLine = srcSpanStartLine span
, disType = typeMeta
, disIsDefinition = True
+ , disUnit = metaCUId
}
addMetaDecl fileDef
addMetaDecl typeMetaDef
- addSubprogram subprogMeta subprog
+ addMetaDecl (MetaUnnamed subprogMeta Distinct subprog)
return $ Just $ MetaAnnot (fsLit "dbg") (MetaNode subprogMeta)
_ -> return Nothing
- let funcMetas = maybeToList subprogAnnot
-
-
let fun = LlvmFunction funDec funArgs llvmStdFunAttrs funSect
- prefix funcMetas lmblocks
+ prefix (maybeToList subprogAnnot) lmblocks
name = decName $ funcDecl fun
defName = llvmDefLabel name
funcDecl' = (funcDecl fun) { decName = defName }
=====================================
compiler/GHC/Driver/Pipeline/Execute.hs
=====================================
@@ -256,9 +256,39 @@ runLlvmOptPhase pipe_env hsc_env input_fn = do
let dflags = hsc_dflags hsc_env
logger = hsc_logger hsc_env
llvm_config <- readLlvmConfigCache (hsc_llvm_config hsc_env)
- let -- we always (unless -optlo specified) run Opt since we rely on it to
+ let -- LLVM debug metadata generation does not support inliner passes currently.
+ -- We have to disable it if debug information is required for the build.
+ -- Fortunately it is already done for `O0` of `opt`, so, we will override to the lowest
+ -- it when debug info is enabled.
+ -- Otherwise LLVM ERROR will be shown for `rts/Apply.cmm` and others.
+ -- The error is very common to rts cmm code.
+ -- inlinable function call in a function with debug info must have a !dbg location
+ -- tail call ghccc void @"cy_info$def"(i64* noalias nocapture nonnull %Base_Arg, i64* noalias nocapture nonnull %ln2l, i64* noalias nocapture %Hp_Arg, i64 %R1_Arg, i64 undef, i64 undef, i64 undef, i64 undef, i64 undef, i64 %SpLim_Arg) #0
+ -- LLVM ERROR: Broken module found, compilation aborted!
+ -- PLEASE submit a bug report to https://bugs.llvm.org/ and include the crash backtrace.
+ -- Stack dump:
+ -- 0. Program arguments: /nix/store/22qzc2gsw44j2w5vkny5m2zlmk42vk9w-llvm-13.0.1/bin/opt -passes=default<O2> -relocation-model=pic /tmp/ghc21926_tmp_0/ghc_tmp_3.ll -o /tmp/ghc21926_tmp_0/ghc_tmp_5.bc
+ -- Stack dump without symbol names (ensure you have llvm-symbolizer in your PATH or set the environment var `LLVM_SYMBOLIZER_PATH` to point to it):
+ -- 0 libLLVM.dylib 0x0000000106d2f3a8 llvm::sys::PrintStackTrace(llvm::raw_ostream&, int) + 72
+ -- 1 libLLVM.dylib 0x0000000106d2e124 llvm::sys::RunSignalHandlers() + 112
+ -- 2 libLLVM.dylib 0x0000000106d2fae8 SignalHandler(int) + 416
+ -- 3 libsystem_platform.dylib 0x0000000196faa584 _sigtramp + 56
+ -- 4 libsystem_pthread.dylib 0x0000000196f79c20 pthread_kill + 288
+ -- 5 libsystem_c.dylib 0x0000000196e86a30 abort + 180
+ -- 6 libLLVM.dylib 0x0000000106c6ddc4 llvm::report_fatal_error(std::__1::basic_string<char, std::__1::char_traits<char>, std::__1::allocator<char> > const&, bool) + 0
+ -- 7 libLLVM.dylib 0x0000000106c6dc10 llvm::report_fatal_error(llvm::Twine const&, bool) + 0
+ -- 8 libLLVM.dylib 0x0000000106efa5e0 llvm::VerifierPass::run(llvm::Function&, llvm::AnalysisManager<llvm::Function>&) + 0
+ -- 9 libLLVM.dylib 0x0000000106ecbac4 llvm::PassManager<llvm::Module, llvm::AnalysisManager<llvm::Module> >::run(llvm::Module&, llvm::AnalysisManager<llvm::Module>&) + 424
+ -- 10 opt 0x0000000100c97bec llvm::runPassPipeline(llvm::StringRef, llvm::Module&, llvm::TargetMachine*, llvm::TargetLibraryInfoImpl*, llvm::ToolOutputFile*, llvm::ToolOutputFile*, llvm::ToolOutputFile*, llvm::StringRef, llvm::ArrayRef<llvm::StringRef>, llvm::opt_tool::OutputKind, llvm::opt_tool::VerifierKind, bool, bool, bool, bool, bool) + 14312
+ -- 11 opt 0x0000000100ca8a28 main + 9588
+ -- 12 dyld 0x0000000196bef154 start + 2476
+ -- `opt' failed in phase `LLVM Optimiser'. (Exit code: -6)
+ maxOptIdxAvailable :: Int = if (debugLevel dflags) >= 1 then 0 else 2
+
+ -- we always (unless -optlo specified) run Opt since we rely on it to
-- fix up some pretty big deficiencies in the code we generate
- optIdx = max 0 $ min 2 $ llvmOptLevel dflags -- ensure we're in [0,2]
+ optIdx = max 0 $ min maxOptIdxAvailable $ llvmOptLevel dflags -- ensure we're in [0,2]
+
llvmOpts = case lookup optIdx $ llvmPasses llvm_config of
Just passes -> passes
Nothing -> panic ("runPhase LlvmOpt: llvm-passes file "
=====================================
compiler/GHC/Llvm/MetaData.hs
=====================================
@@ -96,7 +96,6 @@ data MetaExpr = MetaStr !LMString
, dicuFile :: !MetaId
, dicuProducer :: !LMString
, dicuIsOptimized :: !Bool
- , dicuSubprograms :: !MetaExpr
}
| MetaDISubprogram { disName :: !LMString
, disLinkageName :: !LMString
@@ -105,6 +104,7 @@ data MetaExpr = MetaStr !LMString
, disLine :: !Int
, disType :: !MetaId
, disIsDefinition :: !Bool
+ , disUnit :: !MetaId
}
deriving (Eq)
=====================================
compiler/GHC/Llvm/Ppr.hs
=====================================
@@ -323,7 +323,6 @@ ppMetaExpr opts = \case
, ("isOptimized", if dicuIsOptimized
then text "true"
else text "false")
- , ("subprograms", ppMetaExpr opts $ dicuSubprograms)
]
MetaDISubprogram {..} ->
specialMetadata "DISubprogram"
@@ -336,6 +335,7 @@ ppMetaExpr opts = \case
, ("isDefinition", if disIsDefinition
then text "true"
else text "false")
+ , ("unit" , ppMetaId disUnit)
]
where
specialMetadata :: IsLine doc => String -> [(String, doc)] -> doc
@@ -499,8 +499,12 @@ ppALoad opts ord st var =
ppStore :: IsLine doc => LlvmCgConfig -> LlvmVar -> LlvmVar -> LMAlign -> [MetaAnnot] -> doc
ppStore opts val dst alignment metas =
- text "store" <+> ppVar opts val <> comma <+> ppVar opts dst <> align <+> ppMetaAnnots opts metas
+ text "store" <+> ppVar opts val <> comma <+> ppVar opts dst <> align <> metaComma
where
+ metaComma =
+ case metas of
+ [] -> empty
+ _ -> comma <+> ppMetaAnnots opts metas
align =
case alignment of
Just n -> text ", align" <+> int n
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62eab54ba3dfedac4e3f7e76d1fc3d8d6d84d25b...07c249c3a4e838ce3c99d0da6cb538301dd9b592
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/62eab54ba3dfedac4e3f7e76d1fc3d8d6d84d25b...07c249c3a4e838ce3c99d0da6cb538301dd9b592
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/20250112/c01df3bc/attachment-0001.html>
More information about the ghc-commits
mailing list