diff options
| author | Peter Wortmann <scpmw@leeds.ac.uk> | 2014-12-09 20:59:07 +0100 |
|---|---|---|
| committer | Austin Seipp <austin@well-typed.com> | 2014-12-16 18:34:08 -0600 |
| commit | cc481ec8657e0b91e2f8f9a9eeb3f9ee030635ae (patch) | |
| tree | 75d6fc5f738df1344bb66985413b1393ad4017f6 /compiler/nativeGen/X86/Ppr.hs | |
| parent | 64678e9e8ff0107cac956f0c7b799a1dd317b963 (diff) | |
| download | haskell-cc481ec8657e0b91e2f8f9a9eeb3f9ee030635ae.tar.gz | |
Generate DWARF info section
This is where we actually make GHC emit DWARF code. The info section
contains all the general meta information bits as well as an entry for
every block of native code.
Notes:
* We need quite a few new labels in order to properly address starts
and ends of blocks.
* Thanks to Nathan Howell for taking the iniative to get our own Haskell
language ID for DWARF!
(From Phabricator D396)
Diffstat (limited to 'compiler/nativeGen/X86/Ppr.hs')
| -rw-r--r-- | compiler/nativeGen/X86/Ppr.hs | 15 |
1 files changed, 12 insertions, 3 deletions
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs index 5b4eccd845..982f79a561 100644 --- a/compiler/nativeGen/X86/Ppr.hs +++ b/compiler/nativeGen/X86/Ppr.hs @@ -56,6 +56,7 @@ pprNatCmmDecl (CmmData section dats) = pprSectionHeader section $$ pprDatas dats pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) = + sdocWithDynFlags $ \dflags -> case topInfoTable proc of Nothing -> case blocks of @@ -65,6 +66,8 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) = pprSectionHeader Text $$ pprLabel lbl $$ -- blocks guaranteed not null, so label needed vcat (map (pprBasicBlock top_info) blocks) $$ + (if gopt Opt_Debug dflags + then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$ pprSizeDecl lbl Just (Statics info_lbl _) -> @@ -84,6 +87,8 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) = <+> char '-' <+> ppr (mkDeadStripPreventer info_lbl) else empty) $$ + (if gopt Opt_Debug dflags + then ppr (mkAsmTempEndLabel info_lbl) <> char ':' else empty) $$ pprSizeDecl info_lbl -- | Output the ELF .size directive. @@ -97,10 +102,14 @@ pprSizeDecl lbl pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc pprBasicBlock info_env (BasicBlock blockid instrs) - = maybe_infotable $$ - pprLabel (mkAsmTempLabel (getUnique blockid)) $$ - vcat (map pprInstr instrs) + = sdocWithDynFlags $ \dflags -> + maybe_infotable $$ + pprLabel asmLbl $$ + vcat (map pprInstr instrs) $$ + (if gopt Opt_Debug dflags + then ppr (mkAsmTempEndLabel asmLbl) <> char ':' else empty) where + asmLbl = mkAsmTempLabel (getUnique blockid) maybe_infotable = case mapLookup blockid info_env of Nothing -> empty Just (Statics info_lbl info) -> |