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 ...@@ -38,7 +38,7 @@ newBlockId :: MonadUnique m => m BlockId
newBlockId = mkBlockId <$> getUniqueM newBlockId = mkBlockId <$> getUniqueM
blockLbl :: BlockId -> CLabel blockLbl :: BlockId -> CLabel
blockLbl label = mkEntryLabel (mkFCallName (getUnique label) "block") NoCafRefs blockLbl label = mkAsmTempLabel (getUnique label)
infoTblLbl :: BlockId -> CLabel infoTblLbl :: BlockId -> CLabel
infoTblLbl label = mkInfoTableLabel (mkFCallName (getUnique label) "block") NoCafRefs infoTblLbl label = mkInfoTableLabel (mkFCallName (getUnique label) "block") NoCafRefs
...@@ -52,7 +52,6 @@ import Hoopl.Graph ...@@ -52,7 +52,6 @@ import Hoopl.Graph
-- The rest: -- The rest:
import OrdList import OrdList
import Outputable import Outputable
import Unique
import DynFlags import DynFlags
import Control.Monad ( mapAndUnzipM, when ) import Control.Monad ( mapAndUnzipM, when )
...@@ -214,7 +213,7 @@ getRegisterReg platform (CmmGlobal mid) ...@@ -214,7 +213,7 @@ getRegisterReg platform (CmmGlobal mid)
jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags)) jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel) 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)) = ...@@ -1996,7 +1995,7 @@ generateJumpTableForInstr dflags (BCTR ids (Just lbl)) =
= CmmStaticLit (CmmInt 0 (wordWidth dflags)) = CmmStaticLit (CmmInt 0 (wordWidth dflags))
jumpTableEntryRel (Just blockid) jumpTableEntryRel (Just blockid)
= CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0) = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
where blockLabel = mkAsmTempLabel (getUnique blockid) where blockLabel = blockLbl blockid
in Just (CmmData (Section ReadOnlyData lbl) (Statics lbl jumpTable)) in Just (CmmData (Section ReadOnlyData lbl) (Statics lbl jumpTable))
generateJumpTableForInstr _ _ = Nothing generateJumpTableForInstr _ _ = Nothing
......
...@@ -23,9 +23,10 @@ import Cmm hiding (topInfoTable) ...@@ -23,9 +23,10 @@ import Cmm hiding (topInfoTable)
import Hoopl.Collections import Hoopl.Collections
import Hoopl.Label import Hoopl.Label
import BlockId
import CLabel import CLabel
import Unique ( pprUniqueAlways, Uniquable(..) ) import Unique ( pprUniqueAlways )
import Platform import Platform
import FastString import FastString
import Outputable import Outputable
...@@ -108,7 +109,7 @@ pprFunctionPrologue lab = pprGloblDecl lab ...@@ -108,7 +109,7 @@ pprFunctionPrologue lab = pprGloblDecl lab
pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
pprBasicBlock info_env (BasicBlock blockid instrs) pprBasicBlock info_env (BasicBlock blockid instrs)
= maybe_infotable $$ = maybe_infotable $$
pprLabel (mkAsmTempLabel (getUnique blockid)) $$ pprLabel (blockLbl blockid) $$
vcat (map pprInstr instrs) vcat (map pprInstr instrs)
where where
maybe_infotable = case mapLookup blockid info_env of maybe_infotable = case mapLookup blockid info_env of
...@@ -576,7 +577,7 @@ pprInstr (BCC cond blockid) = hcat [ ...@@ -576,7 +577,7 @@ pprInstr (BCC cond blockid) = hcat [
char '\t', char '\t',
ppr lbl ppr lbl
] ]
where lbl = mkAsmTempLabel (getUnique blockid) where lbl = blockLbl blockid
pprInstr (BCCFAR cond blockid) = vcat [ pprInstr (BCCFAR cond blockid) = vcat [
hcat [ hcat [
...@@ -589,7 +590,7 @@ pprInstr (BCCFAR cond blockid) = vcat [ ...@@ -589,7 +590,7 @@ pprInstr (BCCFAR cond blockid) = vcat [
ppr lbl ppr lbl
] ]
] ]
where lbl = mkAsmTempLabel (getUnique blockid) where lbl = blockLbl blockid
pprInstr (JMP lbl) pprInstr (JMP lbl)
-- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL" -- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL"
......
...@@ -58,7 +58,6 @@ import FastString ...@@ -58,7 +58,6 @@ import FastString
import OrdList import OrdList
import Outputable import Outputable
import Platform import Platform
import Unique
import Control.Monad ( mapAndUnzipM ) import Control.Monad ( mapAndUnzipM )
...@@ -185,7 +184,7 @@ temporary, then do the other computation, and then use the temporary: ...@@ -185,7 +184,7 @@ temporary, then do the other computation, and then use the temporary:
jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags)) jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel) jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
where blockLabel = mkAsmTempLabel (getUnique blockid) where blockLabel = blockLbl blockid
......
...@@ -38,11 +38,12 @@ import PprBase ...@@ -38,11 +38,12 @@ import PprBase
import Cmm hiding (topInfoTable) import Cmm hiding (topInfoTable)
import PprCmm() import PprCmm()
import BlockId
import CLabel import CLabel
import Hoopl.Label import Hoopl.Label
import Hoopl.Collections import Hoopl.Collections
import Unique ( Uniquable(..), pprUniqueAlways ) import Unique ( pprUniqueAlways )
import Outputable import Outputable
import Platform import Platform
import FastString import FastString
...@@ -91,7 +92,7 @@ dspSection = Section Text $ ...@@ -91,7 +92,7 @@ dspSection = Section Text $
pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
pprBasicBlock info_env (BasicBlock blockid instrs) pprBasicBlock info_env (BasicBlock blockid instrs)
= maybe_infotable $$ = maybe_infotable $$
pprLabel (mkAsmTempLabel (getUnique blockid)) $$ pprLabel (blockLbl blockid) $$
vcat (map pprInstr instrs) vcat (map pprInstr instrs)
where where
maybe_infotable = case mapLookup blockid info_env of maybe_infotable = case mapLookup blockid info_env of
...@@ -541,7 +542,7 @@ pprInstr (BI cond b blockid) ...@@ -541,7 +542,7 @@ pprInstr (BI cond b blockid)
text "\tb", pprCond cond, text "\tb", pprCond cond,
if b then pp_comma_a else empty, if b then pp_comma_a else empty,
char '\t', char '\t',
ppr (mkAsmTempLabel (getUnique blockid)) ppr (blockLbl blockid)
] ]
pprInstr (BF cond b blockid) pprInstr (BF cond b blockid)
...@@ -549,7 +550,7 @@ pprInstr (BF cond b blockid) ...@@ -549,7 +550,7 @@ pprInstr (BF cond b blockid)
text "\tfb", pprCond cond, text "\tfb", pprCond cond,
if b then pp_comma_a else empty, if b then pp_comma_a else empty,
char '\t', char '\t',
ppr (mkAsmTempLabel (getUnique blockid)) ppr (blockLbl blockid)
] ]
pprInstr (JMP addr) = text "\tjmp\t" <> pprAddr addr pprInstr (JMP addr) = text "\tjmp\t" <> pprAddr addr
......
...@@ -16,8 +16,6 @@ import BlockId ...@@ -16,8 +16,6 @@ import BlockId
import Cmm import Cmm
import Panic import Panic
import Unique
data JumpDest data JumpDest
...@@ -63,7 +61,7 @@ shortcutStatic _ other_static ...@@ -63,7 +61,7 @@ shortcutStatic _ other_static
shortBlockId :: (BlockId -> Maybe JumpDest) -> BlockId -> CLabel shortBlockId :: (BlockId -> Maybe JumpDest) -> BlockId -> CLabel
shortBlockId fn blockid = shortBlockId fn blockid =
case fn blockid of case fn blockid of
Nothing -> mkAsmTempLabel (getUnique blockid) Nothing -> blockLbl blockid
Just (DestBlockId blockid') -> shortBlockId fn blockid' Just (DestBlockId blockid') -> shortBlockId fn blockid'
Just (DestImm (ImmCLbl lbl)) -> lbl Just (DestImm (ImmCLbl lbl)) -> lbl
_other -> panic "shortBlockId" _other -> panic "shortBlockId"
...@@ -63,7 +63,6 @@ import SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol ) ...@@ -63,7 +63,6 @@ import SrcLoc ( srcSpanFile, srcSpanStartLine, srcSpanStartCol )
import ForeignCall ( CCallConv(..) ) import ForeignCall ( CCallConv(..) )
import OrdList import OrdList
import Outputable import Outputable
import Unique
import FastString import FastString
import DynFlags import DynFlags
import Util import Util
...@@ -326,7 +325,7 @@ is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000 ...@@ -326,7 +325,7 @@ is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic jumpTableEntry :: DynFlags -> Maybe BlockId -> CmmStatic
jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags)) jumpTableEntry dflags Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags))
jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel) jumpTableEntry _ (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
where blockLabel = mkAsmTempLabel (getUnique blockid) where blockLabel = blockLbl blockid
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
...@@ -2764,7 +2763,7 @@ createJumpTable dflags ids section lbl ...@@ -2764,7 +2763,7 @@ createJumpTable dflags ids section lbl
= CmmStaticLit (CmmInt 0 (wordWidth dflags)) = CmmStaticLit (CmmInt 0 (wordWidth dflags))
jumpTableEntryRel (Just blockid) jumpTableEntryRel (Just blockid)
= CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0) = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
where blockLabel = mkAsmTempLabel (getUnique blockid) where blockLabel = blockLbl blockid
in map jumpTableEntryRel ids in map jumpTableEntryRel ids
| otherwise = map (jumpTableEntry dflags) ids | otherwise = map (jumpTableEntry dflags) ids
in CmmData section (1, Statics lbl jumpTable) in CmmData section (1, Statics lbl jumpTable)
......
...@@ -37,8 +37,9 @@ import Hoopl.Label ...@@ -37,8 +37,9 @@ import Hoopl.Label
import BasicTypes (Alignment) import BasicTypes (Alignment)
import DynFlags import DynFlags
import Cmm hiding (topInfoTable) import Cmm hiding (topInfoTable)
import BlockId
import CLabel import CLabel
import Unique ( pprUniqueAlways, Uniquable(..) ) import Unique ( pprUniqueAlways )
import Platform import Platform
import FastString import FastString
import Outputable import Outputable
...@@ -126,7 +127,7 @@ pprBasicBlock info_env (BasicBlock blockid instrs) ...@@ -126,7 +127,7 @@ pprBasicBlock info_env (BasicBlock blockid instrs)
(if debugLevel dflags > 0 (if debugLevel dflags > 0
then ppr (mkAsmTempEndLabel asmLbl) <> char ':' else empty) then ppr (mkAsmTempEndLabel asmLbl) <> char ':' else empty)
where where
asmLbl = mkAsmTempLabel (getUnique blockid) asmLbl = blockLbl blockid
maybe_infotable = case mapLookup blockid info_env of maybe_infotable = case mapLookup blockid info_env of
Nothing -> empty Nothing -> empty
Just (Statics info_lbl info) -> Just (Statics info_lbl info) ->
...@@ -702,7 +703,7 @@ pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op) ...@@ -702,7 +703,7 @@ pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
pprInstr (JXX cond blockid) pprInstr (JXX cond blockid)
= pprCondInstr (sLit "j") cond (ppr lab) = 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) 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