summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'compiler')
-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
5 files changed, 53 insertions, 9 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 ------------------------------------------------------------
View Lorry Controller Status