Commit 8b007abb authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari

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
parent 6252292d
......@@ -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
......@@ -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
......
......@@ -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"
......
......@@ -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
......
......@@ -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
......
......@@ -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"
......@@ -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)
......
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment