[Git][ghc/ghc][master] PPC NCG: Add DWARF constants and debug labels
Marge Bot
gitlab at gitlab.haskell.org
Thu Apr 23 03:12:42 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
34a45ee6 by Peter Trommler at 2020-04-22T23:12:27-04:00
PPC NCG: Add DWARF constants and debug labels
Fixes #11261
- - - - -
10 changed files:
- compiler/GHC/CmmToAsm/Dwarf/Constants.hs
- compiler/GHC/CmmToAsm/PPC/CodeGen.hs
- compiler/GHC/CmmToAsm/PPC/Instr.hs
- compiler/GHC/CmmToAsm/PPC/Ppr.hs
- compiler/GHC/CmmToAsm/PPC/Regs.hs
- testsuite/tests/codeGen/should_compile/all.T
- testsuite/tests/driver/T17586/all.T
- testsuite/tests/rts/all.T
- testsuite/tests/simplCore/should_compile/all.T
- testsuite/tests/simplCore/should_run/all.T
Changes:
=====================================
compiler/GHC/CmmToAsm/Dwarf/Constants.hs
=====================================
@@ -12,6 +12,7 @@ import Outputable
import GHC.Platform.Reg
import GHC.CmmToAsm.X86.Regs
+import GHC.CmmToAsm.PPC.Regs (toRegNo)
import Data.Word
@@ -215,6 +216,7 @@ dwarfRegNo p r = case platformArch p of
| r == xmm13 -> 30
| r == xmm14 -> 31
| r == xmm15 -> 32
+ ArchPPC_64 _ -> fromIntegral $ toRegNo r
_other -> error "dwarfRegNo: Unsupported platform or unknown register!"
-- | Virtual register number to use for return address.
@@ -226,4 +228,5 @@ dwarfReturnRegNo p
= case platformArch p of
ArchX86 -> 8 -- eip
ArchX86_64 -> 16 -- rip
+ ArchPPC_64 ELF_V2 -> 65 -- lr (link register)
_other -> error "dwarfReturnRegNo: Unsupported platform!"
=====================================
compiler/GHC/CmmToAsm/PPC/CodeGen.hs
=====================================
@@ -30,10 +30,13 @@ import GHC.CmmToAsm.PPC.Instr
import GHC.CmmToAsm.PPC.Cond
import GHC.CmmToAsm.PPC.Regs
import GHC.CmmToAsm.CPrim
+import GHC.Cmm.DebugBlock
+ ( DebugBlock(..) )
import GHC.CmmToAsm.Monad
( NatM, getNewRegNat, getNewLabelNat
, getBlockIdNat, getPicBaseNat, getNewRegPairNat
, getPicBaseMaybeNat, getPlatform, getConfig
+ , getDebugBlock, getFileId
)
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.PIC
@@ -53,6 +56,8 @@ import GHC.Cmm.Switch
import GHC.Cmm.CLabel
import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
+import GHC.Core ( Tickish(..) )
+import GHC.Types.SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
-- The rest:
import OrdList
@@ -123,9 +128,17 @@ basicBlockCodeGen block = do
let (_, nodes, tail) = blockSplit block
id = entryLabel block
stmts = blockToList nodes
+ -- Generate location directive
+ dbg <- getDebugBlock (entryLabel block)
+ loc_instrs <- case dblSourceTick =<< dbg of
+ Just (SourceNote span name)
+ -> do fileid <- getFileId (srcSpanFile span)
+ let line = srcSpanStartLine span; col =srcSpanStartCol span
+ return $ unitOL $ LOCATION fileid line col name
+ _ -> return nilOL
mid_instrs <- stmtsToInstrs stmts
tail_instrs <- stmtToInstrs tail
- let instrs = mid_instrs `appOL` tail_instrs
+ let instrs = loc_instrs `appOL` mid_instrs `appOL` tail_instrs
-- code generation may introduce new basic block boundaries, which
-- are indicated by the NEWBLOCK instruction. We must split up the
-- instruction stream into basic blocks again. Also, we extract
=====================================
compiler/GHC/CmmToAsm/PPC/Instr.hs
=====================================
@@ -187,6 +187,9 @@ data Instr
-- comment pseudo-op
= COMMENT FastString
+ -- location pseudo-op (file, line, col, name)
+ | LOCATION Int Int Int String
+
-- some static data spat out during code
-- generation. Will be extracted before
-- pretty-printing.
@@ -643,6 +646,7 @@ ppc_isMetaInstr
ppc_isMetaInstr instr
= case instr of
COMMENT{} -> True
+ LOCATION{} -> True
LDATA{} -> True
NEWBLOCK{} -> True
DELTA{} -> True
=====================================
compiler/GHC/CmmToAsm/PPC/Ppr.hs
=====================================
@@ -59,14 +59,17 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
ArchPPC_64 ELF_V2 -> pprFunctionPrologue lbl
_ -> pprLabel platform lbl) $$ -- blocks guaranteed not null,
-- so label needed
- vcat (map (pprBasicBlock platform top_info) blocks)
+ vcat (map (pprBasicBlock config top_info) blocks) $$
+ (if ncgDebugLevel config > 0
+ then ppr (mkAsmTempEndLabel lbl) <> char ':' else empty) $$
+ pprSizeDecl platform lbl
Just (CmmStaticsRaw info_lbl _) ->
pprSectionAlign config (Section Text info_lbl) $$
(if platformHasSubsectionsViaSymbols platform
then ppr (mkDeadStripPreventer info_lbl) <> char ':'
else empty) $$
- vcat (map (pprBasicBlock platform top_info) blocks) $$
+ vcat (map (pprBasicBlock config top_info) blocks) $$
-- above: Even the first block gets a label, because with branch-chain
-- elimination, it might be the target of a goto.
(if platformHasSubsectionsViaSymbols platform
@@ -76,7 +79,15 @@ pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
<+> ppr info_lbl
<+> char '-'
<+> ppr (mkDeadStripPreventer info_lbl)
- else empty)
+ else empty) $$
+ pprSizeDecl platform info_lbl
+
+-- | Output the ELF .size directive.
+pprSizeDecl :: Platform -> CLabel -> SDoc
+pprSizeDecl platform lbl
+ = if osElfTarget (platformOS platform)
+ then text "\t.size" <+> ppr lbl <> text ", .-" <> ppr lbl
+ else empty
pprFunctionDescriptor :: CLabel -> SDoc
pprFunctionDescriptor lab = pprGloblDecl lab
@@ -105,12 +116,19 @@ pprFunctionPrologue lab = pprGloblDecl lab
$$ text "\t.localentry\t" <> ppr lab
<> text ",.-" <> ppr lab
-pprBasicBlock :: Platform -> LabelMap RawCmmStatics -> NatBasicBlock Instr -> SDoc
-pprBasicBlock platform info_env (BasicBlock blockid instrs)
+pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
+ -> SDoc
+pprBasicBlock config info_env (BasicBlock blockid instrs)
= maybe_infotable $$
- pprLabel platform (blockLbl blockid) $$
- vcat (map (pprInstr platform) instrs)
+ pprLabel platform asmLbl $$
+ vcat (map (pprInstr platform) instrs) $$
+ (if ncgDebugLevel config > 0
+ then ppr (mkAsmTempEndLabel asmLbl) <> char ':'
+ else empty
+ )
where
+ asmLbl = blockLbl blockid
+ platform = ncgPlatform config
maybe_infotable = case mapLookup blockid info_env of
Nothing -> empty
Just (CmmStaticsRaw info_lbl info) ->
@@ -338,6 +356,9 @@ pprInstr platform instr = case instr of
-- then text "# " <> ftext s
-- else text "; " <> ftext s
+ LOCATION file line col _name
+ -> text "\t.loc" <+> ppr file <+> ppr line <+> ppr col
+
DELTA d
-> pprInstr platform (COMMENT (mkFastString ("\tdelta = " ++ show d)))
=====================================
compiler/GHC/CmmToAsm/PPC/Regs.hs
=====================================
@@ -31,6 +31,7 @@ module GHC.CmmToAsm.PPC.Regs (
allMachRegNos,
classOfRealReg,
showReg,
+ toRegNo,
-- machine specific
allFPArgRegs,
@@ -250,7 +251,9 @@ showReg n
| n >= 32 && n <= 63 = "%f" ++ show (n - 32)
| otherwise = "%unknown_powerpc_real_reg_" ++ show n
-
+toRegNo :: Reg -> RegNo
+toRegNo (RegReal (RealRegSingle n)) = n
+toRegNo _ = panic "PPC.toRegNo: unsupported register"
-- machine specific ------------------------------------------------------------
=====================================
testsuite/tests/codeGen/should_compile/all.T
=====================================
@@ -25,19 +25,14 @@ test('T9155', normal, compile, ['-O2'])
test('T9303', normal, compile, ['-O2'])
test('T9329', [when(unregisterised(), expect_broken(15467)), cmm_src], compile, [''])
-test('debug',
- [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))],
- makefile_test, [])
+test('debug', normal, makefile_test, [])
test('T9964', normal, compile, ['-O'])
test('T10518', [cmm_src], compile, [''])
-test('T10667', [ when((arch('powerpc64') or arch('powerpc64le')),
- expect_broken(11261))],
- compile, ['-g'])
+test('T10667', normal, compile, ['-g'])
test('T12115', normal, compile, [''])
test('T12355', normal, compile, [''])
test('T14999',
- [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261)),
- when(unregisterised(), skip),
+ [when(unregisterised(), skip),
unless(opsys('linux') and arch('x86_64') and have_gdb() and
have_readelf(), skip)],
makefile_test, [])
=====================================
testsuite/tests/driver/T17586/all.T
=====================================
@@ -1,3 +1 @@
-test('T17586',
- [when(arch('powerpc64') or arch('powerpc64le'), expect_broken(11261))],
- makefile_test, [])
+test('T17586', normal, makefile_test, [])
=====================================
testsuite/tests/rts/all.T
=====================================
@@ -385,10 +385,10 @@ test('keep-cafs-fail',
[ extra_files(['KeepCafsBase.hs', 'KeepCafs1.hs',
'KeepCafs2.hs', 'KeepCafsMain.hs']),
when(opsys('mingw32'), expect_broken (5987)),
- when(platform('powerpc64le-unknown-linux'), expect_broken(11261)),
when(opsys('freebsd'), expect_broken(16035)),
filter_stdout_lines('Evaluated a CAF|exit.*'),
ignore_stderr, # on OS X the shell emits an "Abort trap" message to stderr
+ req_rts_linker,
],
makefile_test, ['KeepCafsFail'])
@@ -397,7 +397,6 @@ test('keep-cafs',
[ extra_files(['KeepCafsBase.hs', 'KeepCafs1.hs',
'KeepCafs2.hs', 'KeepCafsMain.hs']),
when(opsys('mingw32'), expect_broken (5987)),
- when(platform('powerpc64le-unknown-linux'), expect_broken(11261)),
when(opsys('freebsd'), expect_broken(16035)),
req_rts_linker
],
=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -244,21 +244,11 @@ test('T13468',
normal,
makefile_test, ['T13468'])
test('T13543', only_ways(['optasm']), compile, ['-ddump-str-signatures -ddump-cpr-signatures'])
-test('T11272',
- normal,
- makefile_test, ['T11272'])
-test('T12600',
- normal,
- makefile_test, ['T12600'])
-test('T13658',
- [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))],
- compile, ['-dcore-lint'])
-test('T14779a',
- [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))],
- compile, ['-dcore-lint'])
-test('T14779b',
- [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))],
- compile, ['-dcore-lint'])
+test('T11272', normal, makefile_test, ['T11272'])
+test('T12600', normal, makefile_test, ['T12600'])
+test('T13658', normal, compile, ['-dcore-lint'])
+test('T14779a', normal, compile, ['-dcore-lint'])
+test('T14779b', normal, compile, ['-dcore-lint'])
test('T13708', normal, compile, [''])
# thunk should inline here, so check whether or not it appears in the Core
=====================================
testsuite/tests/simplCore/should_run/all.T
=====================================
@@ -81,10 +81,8 @@ test('T13429_2', normal, compile_and_run, [''])
test('T13750', normal, compile_and_run, [''])
test('T14178', normal, compile_and_run, [''])
test('T14768', reqlib('vector'), compile_and_run, [''])
-test('T14868',
- [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))],
- compile_and_run, [''])
-test('T14894', [when((arch('powerpc64') or arch('powerpc64le')), expect_broken(11261))], compile_and_run, [''])
+test('T14868', normal, compile_and_run, [''])
+test('T14894', normal, compile_and_run, [''])
test('T14965', normal, compile_and_run, [''])
test('T15114', only_ways(['optasm']), compile_and_run, [''])
test('T15436', normal, compile_and_run, [''])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34a45ee600d5346f5d1728047fa185698ed7ee84
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/34a45ee600d5346f5d1728047fa185698ed7ee84
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/20200422/dc8620cc/attachment-0001.html>
More information about the ghc-commits
mailing list