Fix PPC NCG after blockID patch

Commit rGHC8b007ab assigns the same label to the first basic block
of a proc and to the proc entry point. This violates the PPC 64-bit ELF
v. 1.9 and v. 2.0 ABIs and leads to duplicate symbols.

This patch fixes duplicate symbols caused by block labels

In commit rGHCd7b8da1 an info table label is generated from a block id.
Getting the entry label from that info label leads to an undefined
symbol because a suffix "_entry" that is not present in the block label.

To fix that issue add a new info table label flavour for labels
derived from block ids. Converting such a label with toEntryLabel
produces the original block label.

Fixes #14311

Test Plan: ./validate

Reviewers: austin, bgamari, simonmar, erikd, hvr, angerman

Reviewed By: bgamari

Subscribers: rwbarton, thomie

GHC Trac Issues: #14311

Differential Revision: https://phabricator.haskell.org/D4149

3 files changed, 22 insertions, 18 deletions

diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index d37f385a18..898a31a657 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -91,13 +91,23 @@ cmmTopCodeGen (CmmProc info lab live graph) = do
       case picBaseMb of
            Just picBase -> initializePicBase_ppc arch os picBase tops
            Nothing -> return tops
-    ArchPPC_64 ELF_V1 -> return tops
+    ArchPPC_64 ELF_V1 -> fixup_entry tops
                       -- generating function descriptor is handled in
                       -- pretty printer
-    ArchPPC_64 ELF_V2 -> return tops
+    ArchPPC_64 ELF_V2 -> fixup_entry tops
                       -- generating function prologue is handled in
                       -- pretty printer
     _          -> panic "PPC.cmmTopCodeGen: unknown arch"
+    where
+      fixup_entry (CmmProc info lab live (ListGraph (entry:blocks)) : statics)
+        = do
+        let BasicBlock bID insns = entry
+        bID' <- if lab == (blockLbl bID)
+                then newBlockId
+                else return bID
+        let b' = BasicBlock bID' insns
+        return (CmmProc info lab live (ListGraph (b':blocks)) : statics)
+      fixup_entry _ = panic "cmmTopCodegen: Broken CmmProc"
 
 cmmTopCodeGen (CmmData sec dat) = do
   return [CmmData sec dat]  -- no translation, we just use CmmStatic
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index cef3eb7cd8..d21e7f8176 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -648,10 +648,6 @@ ppc_mkRegRegMoveInstr src dst
 
 
 -- | Make an unconditional jump instruction.
--- For architectures with branch delay slots, its ok to put
--- a NOP after the jump. Don't fill the delay slot with an
--- instruction that references regs or you'll confuse the
--- linear allocator.
 ppc_mkJumpInstr
     :: BlockId
     -> [Instr]
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 70735f9f85..101628e3a3 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -81,19 +81,17 @@ pprNatCmmDecl proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
 
 pprFunctionDescriptor :: CLabel -> SDoc
 pprFunctionDescriptor lab = pprGloblDecl lab
-                        $$  text ".section \".opd\",\"aw\""
-                        $$  text ".align 3"
+                        $$  text "\t.section \".opd\", \"aw\""
+                        $$  text "\t.align 3"
                         $$  ppr lab <> char ':'
-                        $$  text ".quad ."
-                        <> ppr lab
-                        <> text ",.TOC.@tocbase,0"
-                        $$  text ".previous"
-                        $$  text ".type "
-                        <> ppr lab
-                        <> text ", @function"
-                        $$  char '.'
-                        <> ppr lab
-                        <> char ':'
+                        $$  text "\t.quad ."
+                        <>  ppr lab
+                        <>  text ",.TOC.@tocbase,0"
+                        $$  text "\t.previous"
+                        $$  text "\t.type"
+                        <+> ppr lab
+                        <>  text ", @function"
+                        $$  char '.' <> ppr lab <> char ':'
 
 pprFunctionPrologue :: CLabel ->SDoc
 pprFunctionPrologue lab =  pprGloblDecl lab