nativeGen: Consistently use blockLbl to generate CLabels from BlockIds

This fixes #14221, where the NCG and the DWARF code were apparently
giving two different names to the same block.

Test Plan: Validate with DWARF support enabled.

Reviewers: simonmar, austin

Subscribers: rwbarton, thomie

GHC Trac Issues: #14221

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

compiler/cmm/BlockId.hs

@@ -38,7 +38,7 @@ newBlockId :: MonadUnique m => m BlockId
 newBlockId = mkBlockId <$> getUniqueM
 
 blockLbl :: BlockId -> CLabel
-blockLbl label = mkEntryLabel (mkFCallName (getUnique label) "block") NoCafRefs
+blockLbl label = mkAsmTempLabel (getUnique label)
 
 infoTblLbl :: BlockId -> CLabel
 infoTblLbl label = mkInfoTableLabel (mkFCallName (getUnique label) "block") NoCafRefs

compiler/nativeGen/PPC/CodeGen.hs

@@ -52,7 +52,6 @@ import Hoopl.Graph
 -- The rest:
 import OrdList
 import Outputable
-import Unique
 import DynFlags
 
 import Control.Monad    ( mapAndUnzipM, when )
@@ -214,7 +213,7 @@ getRegisterReg platform (CmmGlobal mid)
 jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
 jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
 jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
-    where blockLabel = mkAsmTempLabel (getUnique blockid)
+    where blockLabel = blockLbl blockid
 
 
 
@@ -1996,7 +1995,7 @@ generateJumpTableForInstr dflags (BCTR ids (Just lbl)) =
                         = CmmStaticLit (CmmInt 0 (wordWidth dflags))
                       jumpTableEntryRel (Just blockid)
                         = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
-                            where blockLabel = mkAsmTempLabel (getUnique blockid)
+                            where blockLabel = blockLbl blockid
     in Just (CmmData (Section ReadOnlyData lbl) (Statics lbl jumpTable))
 generateJumpTableForInstr _ _ = Nothing
 

compiler/nativeGen/PPC/Ppr.hs

@@ -23,9 +23,10 @@ import Cmm hiding (topInfoTable)
 import Hoopl.Collections
 import Hoopl.Label
 
+import BlockId
 import CLabel
 
-import Unique                ( pprUniqueAlways, Uniquable(..) )
+import Unique                ( pprUniqueAlways )
 import Platform
 import FastString
 import Outputable
@@ -108,7 +109,7 @@ pprFunctionPrologue lab =  pprGloblDecl lab
 pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
 pprBasicBlock info_env (BasicBlock blockid instrs)
   = maybe_infotable $$
-    pprLabel (mkAsmTempLabel (getUnique blockid)) $$
+    pprLabel (blockLbl blockid) $$
     vcat (map pprInstr instrs)
   where
     maybe_infotable = case mapLookup blockid info_env of
@@ -576,7 +577,7 @@ pprInstr (BCC cond blockid) = hcat [
         char '\t',
         ppr lbl
     ]
-    where lbl = mkAsmTempLabel (getUnique blockid)
+    where lbl = blockLbl blockid
 
 pprInstr (BCCFAR cond blockid) = vcat [
         hcat [
@@ -589,7 +590,7 @@ pprInstr (BCCFAR cond blockid) = vcat [
             ppr lbl
         ]
     ]
-    where lbl = mkAsmTempLabel (getUnique blockid)
+    where lbl = blockLbl blockid
 
 pprInstr (JMP lbl)
   -- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL"

compiler/nativeGen/SPARC/CodeGen.hs

@@ -58,7 +58,6 @@ import FastString
 import OrdList
 import Outputable
 import Platform
-import Unique
 
 import Control.Monad    ( mapAndUnzipM )
 
@@ -185,7 +184,7 @@ temporary, then do the other computation, and then use the temporary:
 jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
 jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
 jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
-    where blockLabel = mkAsmTempLabel (getUnique blockid)
+    where blockLabel = blockLbl blockid
 
 
 

compiler/nativeGen/SPARC/Ppr.hs

@@ -38,11 +38,12 @@ import PprBase
 
 import Cmm hiding (topInfoTable)
 import PprCmm()
+import BlockId
 import CLabel
 import Hoopl.Label
 import Hoopl.Collections
 
-import Unique           ( Uniquable(..), pprUniqueAlways )
+import Unique           ( pprUniqueAlways )
 import Outputable
 import Platform
 import FastString
@@ -91,7 +92,7 @@ dspSection = Section Text $
 pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
 pprBasicBlock info_env (BasicBlock blockid instrs)
   = maybe_infotable $$
-    pprLabel (mkAsmTempLabel (getUnique blockid)) $$
+    pprLabel (blockLbl blockid) $$
     vcat (map pprInstr instrs)
   where
     maybe_infotable = case mapLookup blockid info_env of
@@ -541,7 +542,7 @@ pprInstr (BI cond b blockid)
         text "\tb", pprCond cond,
         if b then pp_comma_a else empty,
         char '\t',
-        ppr (mkAsmTempLabel (getUnique blockid))
+        ppr (blockLbl blockid)
     ]
 
 pprInstr (BF cond b blockid)
@@ -549,7 +550,7 @@ pprInstr (BF cond b blockid)
         text "\tfb", pprCond cond,
         if b then pp_comma_a else empty,
         char '\t',
-        ppr (mkAsmTempLabel (getUnique blockid))
+        ppr (blockLbl blockid)
     ]
 
 pprInstr (JMP addr) = text "\tjmp\t" <> pprAddr addr

compiler/nativeGen/SPARC/ShortcutJump.hs

@@ -16,8 +16,6 @@ import BlockId
 import Cmm
 
 import Panic
-import Unique
-
 
 
 data JumpDest
@@ -63,7 +61,7 @@ shortcutStatic _ other_static
 shortBlockId :: (BlockId -> Maybe JumpDest) -> BlockId -> CLabel
 shortBlockId fn blockid =
    case fn blockid of
-      Nothing -> mkAsmTempLabel (getUnique blockid)
+      Nothing -> blockLbl blockid
       Just (DestBlockId blockid')  -> shortBlockId fn blockid'
       Just (DestImm (ImmCLbl lbl)) -> lbl
       _other -> panic "shortBlockId"

compiler/nativeGen/X86/CodeGen.hs

@@ -63,7 +63,6 @@ import SrcLoc           ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
 import ForeignCall      ( CCallConv(..) )
 import OrdList
 import Outputable
-import Unique
 import FastString
 import DynFlags
 import Util
@@ -326,7 +325,7 @@ is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
 jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
 jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
 jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
-    where blockLabel = mkAsmTempLabel (getUnique blockid)
+    where blockLabel = blockLbl blockid
 
 
 -- -----------------------------------------------------------------------------
@@ -2764,7 +2763,7 @@ createJumpTable dflags ids section lbl
                           = CmmStaticLit (CmmInt 0 (wordWidth dflags))
                       jumpTableEntryRel (Just blockid)
                           = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
-                          where blockLabel = mkAsmTempLabel (getUnique blockid)
+                          where blockLabel = blockLbl blockid
                   in map jumpTableEntryRel ids
             | otherwise = map (jumpTableEntry dflags) ids
       in CmmData section (1, Statics lbl jumpTable)

compiler/nativeGen/X86/Ppr.hs

@@ -37,8 +37,9 @@ import Hoopl.Label
 import BasicTypes       (Alignment)
 import DynFlags
 import Cmm              hiding (topInfoTable)
+import BlockId
 import CLabel
-import Unique           ( pprUniqueAlways, Uniquable(..) )
+import Unique           ( pprUniqueAlways )
 import Platform
 import FastString
 import Outputable
@@ -126,7 +127,7 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
     (if debugLevel dflags > 0
      then ppr (mkAsmTempEndLabel asmLbl) <> char ':' else empty)
   where
-    asmLbl = mkAsmTempLabel (getUnique blockid)
+    asmLbl = blockLbl blockid
     maybe_infotable = case mapLookup blockid info_env of
        Nothing   -> empty
        Just (Statics info_lbl info) ->
@@ -702,7 +703,7 @@ pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
 
 pprInstr (JXX cond blockid)
   = pprCondInstr (sLit "j") cond (ppr lab)
-  where lab = mkAsmTempLabel (getUnique blockid)
+  where lab = blockLbl blockid
 
 pprInstr        (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)