summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/CmmToAsm/Dwarf/Constants.hs3
-rw-r--r--compiler/GHC/CmmToAsm/PPC/CodeGen.hs15
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Instr.hs4
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Ppr.hs35
-rw-r--r--compiler/GHC/CmmToAsm/PPC/Regs.hs5
-rw-r--r--testsuite/tests/codeGen/should_compile/all.T11
-rw-r--r--testsuite/tests/driver/T17586/all.T4
-rw-r--r--testsuite/tests/rts/all.T3
-rw-r--r--testsuite/tests/simplCore/should_compile/all.T20
-rw-r--r--testsuite/tests/simplCore/should_run/all.T6
10 files changed, 65 insertions, 41 deletions
diff --git a/compiler/GHC/CmmToAsm/Dwarf/Constants.hs b/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
index 16bdded699..29592c106e 100644
--- a/compiler/GHC/CmmToAsm/Dwarf/Constants.hs
+++ b/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!"
diff --git a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs b/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
index 90b670c9b0..16557dba71 100644
--- a/compiler/GHC/CmmToAsm/PPC/CodeGen.hs
+++ b/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
diff --git a/compiler/GHC/CmmToAsm/PPC/Instr.hs b/compiler/GHC/CmmToAsm/PPC/Instr.hs
index e622d801a8..674b19ef93 100644
--- a/compiler/GHC/CmmToAsm/PPC/Instr.hs
+++ b/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
diff --git a/compiler/GHC/CmmToAsm/PPC/Ppr.hs b/compiler/GHC/CmmToAsm/PPC/Ppr.hs
index b4b9ee804e..15e72bbb49 100644
--- a/compiler/GHC/CmmToAsm/PPC/Ppr.hs
+++ b/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)))
diff --git a/compiler/GHC/CmmToAsm/PPC/Regs.hs b/compiler/GHC/CmmToAsm/PPC/Regs.hs
index 86675daf5f..b37fb400fc 100644
--- a/compiler/GHC/CmmToAsm/PPC/Regs.hs
+++ b/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 ------------------------------------------------------------
diff --git a/testsuite/tests/codeGen/should_compile/all.T b/testsuite/tests/codeGen/should_compile/all.T
index cffe3d9769..ce76ed388a 100644
--- a/testsuite/tests/codeGen/should_compile/all.T
+++ b/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, [])
diff --git a/testsuite/tests/driver/T17586/all.T b/testsuite/tests/driver/T17586/all.T
index 3912ef34db..2ec89b4d03 100644
--- a/testsuite/tests/driver/T17586/all.T
+++ b/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, [])
diff --git a/testsuite/tests/rts/all.T b/testsuite/tests/rts/all.T
index ca0e652a48..61e525b938 100644
--- a/testsuite/tests/rts/all.T
+++ b/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
],
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 396111fb4b..875e0b5b66 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/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
diff --git a/testsuite/tests/simplCore/should_run/all.T b/testsuite/tests/simplCore/should_run/all.T
index 210949d9c6..d730632345 100644
--- a/testsuite/tests/simplCore/should_run/all.T
+++ b/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 Lorry Controller Status