summaryrefslogtreecommitdiff
path: root/compiler/nativeGen
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/nativeGen')
-rw-r--r--compiler/nativeGen/AsmCodeGen.hs4
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/Main.hs5
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/Spill.hs8
-rw-r--r--compiler/nativeGen/RegAlloc/Graph/SpillCost.hs2
-rw-r--r--compiler/nativeGen/RegAlloc/Linear/Main.hs2
-rw-r--r--compiler/nativeGen/RegAlloc/Liveness.hs32
6 files changed, 27 insertions, 26 deletions
diff --git a/compiler/nativeGen/AsmCodeGen.hs b/compiler/nativeGen/AsmCodeGen.hs
index 8c62a15429..4672415ec5 100644
--- a/compiler/nativeGen/AsmCodeGen.hs
+++ b/compiler/nativeGen/AsmCodeGen.hs
@@ -587,9 +587,7 @@ cmmNativeGen dflags this_mod modLoc ncgImpl us fileIds dbgMap cmm count
let (withLiveness, usLive) =
{-# SCC "regLiveness" #-}
initUs usGen
- $ mapM (regLiveness platform)
- -- TODO: Only use CFG for x86
- $ map (natCmmTopToLive livenessCfg) native
+ $ mapM (cmmTopLiveness livenessCfg platform) native
dumpIfSet_dyn dflags
Opt_D_dump_asm_liveness "Liveness annotations added"
diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs
index 146f88a8b6..c7875cfaea 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs
@@ -89,7 +89,8 @@ regAlloc dflags regsFree slotsFree slotsCount code cfg
-- and try to colour it again. After `maxSpinCount` iterations we give up.
--
regAlloc_spin
- :: (Instruction instr,
+ :: forall instr statics.
+ (Instruction instr,
Outputable instr,
Outputable statics)
=> DynFlags
@@ -180,7 +181,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGrap
| otherwise
= reg
- let code_coalesced
+ let (code_coalesced :: [LiveCmmDecl statics instr])
= map (patchEraseLive patchF) code
-- Check whether we've found a coloring.
diff --git a/compiler/nativeGen/RegAlloc/Graph/Spill.hs b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
index 2e1879926e..bc26a663a5 100644
--- a/compiler/nativeGen/RegAlloc/Graph/Spill.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/Spill.hs
@@ -105,12 +105,8 @@ regSpill_top platform regSlotMap cmm
-> return cmm
CmmProc info label live sccs
- | LiveInfo static firstId mLiveVRegsOnEntry liveSlotsOnEntry <- info
+ | LiveInfo static firstId liveVRegsOnEntry liveSlotsOnEntry <- info
-> do
- -- We should only passed Cmms with the liveness maps filled in,
- -- but we'll create empty ones if they're not there just in case.
- let liveVRegsOnEntry = fromMaybe mapEmpty mLiveVRegsOnEntry
-
-- The liveVRegsOnEntry contains the set of vregs that are live
-- on entry to each basic block. If we spill one of those vregs
-- we remove it from that set and add the corresponding slot
@@ -124,7 +120,7 @@ regSpill_top platform regSlotMap cmm
let info'
= LiveInfo static firstId
- (Just liveVRegsOnEntry)
+ liveVRegsOnEntry
liveSlotsOnEntry'
-- Apply the spiller to all the basic blocks in the CmmProc.
diff --git a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
index 4d5f44a8d3..b62c44fa81 100644
--- a/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
+++ b/compiler/nativeGen/RegAlloc/Graph/SpillCost.hs
@@ -94,7 +94,7 @@ slurpSpillCostInfo platform cfg cmm
-- Lookup the regs that are live on entry to this block in
-- the info table from the CmmProc.
countBlock info (BasicBlock blockId instrs)
- | LiveInfo _ _ (Just blockLive) _ <- info
+ | LiveInfo _ _ blockLive _ <- info
, Just rsLiveEntry <- mapLookup blockId blockLive
, rsLiveEntry_virt <- takeVirtuals rsLiveEntry
= countLIs (loopMember blockId) rsLiveEntry_virt instrs
diff --git a/compiler/nativeGen/RegAlloc/Linear/Main.hs b/compiler/nativeGen/RegAlloc/Linear/Main.hs
index bcac084c5f..a9337b0044 100644
--- a/compiler/nativeGen/RegAlloc/Linear/Main.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/Main.hs
@@ -162,7 +162,7 @@ regAlloc _ (CmmProc (LiveInfo info _ _ _) lbl live [])
, Nothing )
regAlloc dflags (CmmProc static lbl live sccs)
- | LiveInfo info entry_ids@(first_id:_) (Just block_live) _ <- static
+ | LiveInfo info entry_ids@(first_id:_) block_live _ <- static
= do
-- do register allocation on each component.
(final_blocks, stats, stack_use)
diff --git a/compiler/nativeGen/RegAlloc/Liveness.hs b/compiler/nativeGen/RegAlloc/Liveness.hs
index b7f8d1c871..065231faf3 100644
--- a/compiler/nativeGen/RegAlloc/Liveness.hs
+++ b/compiler/nativeGen/RegAlloc/Liveness.hs
@@ -33,7 +33,7 @@ module RegAlloc.Liveness (
patchRegsLiveInstr,
reverseBlocksInTops,
regLiveness,
- natCmmTopToLive
+ cmmTopLiveness
) where
import GhcPrelude
@@ -178,7 +178,7 @@ data LiveInfo
(LabelMap CmmStatics) -- cmm info table static stuff
[BlockId] -- entry points (first one is the
-- entry point for the proc).
- (Maybe (BlockMap RegSet)) -- argument locals live on entry to this block
+ (BlockMap RegSet) -- argument locals live on entry to this block
(BlockMap IntSet) -- stack slots live on entry to this block
@@ -319,7 +319,7 @@ slurpConflicts live
= foldl' (slurpBlock info) rs bs
slurpBlock info rs (BasicBlock blockId instrs)
- | LiveInfo _ _ (Just blockLive) _ <- info
+ | LiveInfo _ _ blockLive _ <- info
, Just rsLiveEntry <- mapLookup blockId blockLive
, (conflicts, moves) <- slurpLIs rsLiveEntry rs instrs
= (consBag rsLiveEntry conflicts, moves)
@@ -577,18 +577,15 @@ patchEraseLive patchF cmm
patchCmm cmm@CmmData{} = cmm
patchCmm (CmmProc info label live sccs)
- | LiveInfo static id (Just blockMap) mLiveSlots <- info
+ | LiveInfo static id blockMap mLiveSlots <- info
= let
patchRegSet set = mkUniqSet $ map patchF $ nonDetEltsUFM set
-- See Note [Unique Determinism and code generation]
blockMap' = mapMap (patchRegSet . getUniqSet) blockMap
- info' = LiveInfo static id (Just blockMap') mLiveSlots
+ info' = LiveInfo static id blockMap' mLiveSlots
in CmmProc info' label live $ map patchSCC sccs
- | otherwise
- = panic "RegAlloc.Liveness.patchEraseLive: no blockMap"
-
patchSCC (AcyclicSCC b) = AcyclicSCC (patchBlock b)
patchSCC (CyclicSCC bs) = CyclicSCC (map patchBlock bs)
@@ -644,7 +641,15 @@ patchRegsLiveInstr patchF li
--------------------------------------------------------------------------------
--- | Convert a NatCmmDecl to a LiveCmmDecl, with empty liveness information
+-- | Convert a NatCmmDecl to a LiveCmmDecl, with liveness information
+
+cmmTopLiveness
+ :: (Outputable instr, Instruction instr)
+ => Maybe CFG -> Platform
+ -> NatCmmDecl statics instr
+ -> UniqSM (LiveCmmDecl statics instr)
+cmmTopLiveness cfg platform cmm
+ = regLiveness platform $ natCmmTopToLive cfg cmm
natCmmTopToLive
:: (Instruction instr, Outputable instr)
@@ -655,10 +660,10 @@ natCmmTopToLive _ (CmmData i d)
= CmmData i d
natCmmTopToLive _ (CmmProc info lbl live (ListGraph []))
- = CmmProc (LiveInfo info [] Nothing mapEmpty) lbl live []
+ = CmmProc (LiveInfo info [] mapEmpty mapEmpty) lbl live []
natCmmTopToLive mCfg proc@(CmmProc info lbl live (ListGraph blocks@(first : _)))
- = CmmProc (LiveInfo info' (first_id : entry_ids) Nothing mapEmpty)
+ = CmmProc (LiveInfo info' (first_id : entry_ids) mapEmpty mapEmpty)
lbl live sccsLive
where
first_id = blockId first
@@ -731,6 +736,7 @@ sccBlocks blocks entries mcfg = map (fmap node_payload) sccs
--------------------------------------------------------------------------------
-- Annotate code with register liveness information
--
+
regLiveness
:: (Outputable instr, Instruction instr)
=> Platform
@@ -743,14 +749,14 @@ regLiveness _ (CmmData i d)
regLiveness _ (CmmProc info lbl live [])
| LiveInfo static mFirst _ _ <- info
= return $ CmmProc
- (LiveInfo static mFirst (Just mapEmpty) mapEmpty)
+ (LiveInfo static mFirst mapEmpty mapEmpty)
lbl live []
regLiveness platform (CmmProc info lbl live sccs)
| LiveInfo static mFirst _ liveSlotsOnEntry <- info
= let (ann_sccs, block_live) = computeLiveness platform sccs
- in return $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
+ in return $ CmmProc (LiveInfo static mFirst block_live liveSlotsOnEntry)
lbl live ann_sccs
View Lorry Controller Status