summaryrefslogtreecommitdiff
path: root/compiler/GHC/CmmToAsm/Reg
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/CmmToAsm/Reg')
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Graph.hs44
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs36
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Linear.hs49
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Linear/Base.hs6
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs36
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs14
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs5
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Linear/State.hs31
-rw-r--r--compiler/GHC/CmmToAsm/Reg/Liveness.hs18
9 files changed, 123 insertions, 116 deletions
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph.hs b/compiler/GHC/CmmToAsm/Reg/Graph.hs
index 6dfe84cf95..7f0cacfcb4 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph.hs
@@ -16,11 +16,11 @@ import GHC.CmmToAsm.Reg.Graph.Stats
import GHC.CmmToAsm.Reg.Graph.TrivColorable
import GHC.CmmToAsm.Instr
import GHC.CmmToAsm.Reg.Target
+import GHC.CmmToAsm.Config
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import Bag
-import GHC.Driver.Session
import Outputable
import GHC.Platform
import UniqFM
@@ -45,7 +45,7 @@ maxSpinCount = 10
-- | The top level of the graph coloring register allocator.
regAlloc
:: (Outputable statics, Outputable instr, Instruction instr)
- => DynFlags
+ => NCGConfig
-> UniqFM (UniqSet RealReg) -- ^ registers we can use for allocation
-> UniqSet Int -- ^ set of available spill slots.
-> Int -- ^ current number of spill slots
@@ -56,18 +56,15 @@ regAlloc
-- ^ code with registers allocated, additional stacks required
-- and stats for each stage of allocation
-regAlloc dflags regsFree slotsFree slotsCount code cfg
+regAlloc config regsFree slotsFree slotsCount code cfg
= do
- -- TODO: the regClass function is currently hard coded to the default
- -- target architecture. Would prefer to determine this from dflags.
- -- There are other uses of targetRegClass later in this module.
- let platform = targetPlatform dflags
+ let platform = ncgPlatform config
triv = trivColorable platform
(targetVirtualRegSqueeze platform)
(targetRealRegSqueeze platform)
(code_final, debug_codeGraphs, slotsCount', _)
- <- regAlloc_spin dflags 0
+ <- regAlloc_spin config 0
triv
regsFree slotsFree slotsCount [] code cfg
@@ -94,7 +91,7 @@ regAlloc_spin
(Instruction instr,
Outputable instr,
Outputable statics)
- => DynFlags
+ => NCGConfig
-> Int -- ^ Number of solver iterations we've already performed.
-> Color.Triv VirtualReg RegClass RealReg
-- ^ Function for calculating whether a register is trivially
@@ -110,17 +107,18 @@ regAlloc_spin
, Int -- Slots in use
, Color.Graph VirtualReg RegClass RealReg)
-regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGraphs code cfg
+regAlloc_spin config spinCount triv regsFree slotsFree slotsCount debug_codeGraphs code cfg
= do
- let platform = targetPlatform dflags
+ let platform = ncgPlatform config
-- If any of these dump flags are turned on we want to hang on to
-- intermediate structures in the allocator - otherwise tell the
-- allocator to ditch them early so we don't end up creating space leaks.
let dump = or
- [ dopt Opt_D_dump_asm_regalloc_stages dflags
- , dopt Opt_D_dump_asm_stats dflags
- , dopt Opt_D_dump_asm_conflicts dflags ]
+ [ ncgDumpRegAllocStages config
+ , ncgDumpAsmStats config
+ , ncgDumpAsmConflicts config
+ ]
-- Check that we're not running off down the garden path.
when (spinCount > maxSpinCount)
@@ -161,14 +159,16 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGrap
then Just $ RegAllocStatsStart
{ raLiveCmm = code
, raGraph = graph
- , raSpillCosts = spillCosts }
+ , raSpillCosts = spillCosts
+ , raPlatform = platform
+ }
else Nothing
-- Try and color the graph.
let (graph_colored, rsSpill, rmCoalesce)
= {-# SCC "ColorGraph" #-}
Color.colorGraph
- (gopt Opt_RegsIterative dflags)
+ (ncgRegsIterative config)
spinCount
regsFree triv spill graph
@@ -193,7 +193,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGrap
-- if -fasm-lint is turned on then validate the graph.
-- This checks for bugs in the graph allocator itself.
let graph_colored_lint =
- if gopt Opt_DoAsmLinting dflags
+ if ncgAsmLinting config
then Color.validateGraph (text "")
True -- Require all nodes to be colored.
graph_colored
@@ -215,7 +215,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGrap
-- Also rewrite SPILL/RELOAD meta instructions into real machine
-- instructions along the way
let code_final
- = map (stripLive dflags) code_spillclean
+ = map (stripLive config) code_spillclean
-- Record what happened in this stage for debugging
let stat
@@ -229,7 +229,9 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGrap
, raSpillClean = code_spillclean
, raFinal = code_final
, raSRMs = foldl' addSRM (0, 0, 0)
- $ map countSRMs code_spillclean }
+ $ map countSRMs code_spillclean
+ , raPlatform = platform
+ }
-- Bundle up all the register allocator statistics.
-- .. but make sure to drop them on the floor if they're not
@@ -251,7 +253,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGrap
else do
-- if -fasm-lint is turned on then validate the graph
let graph_colored_lint =
- if gopt Opt_DoAsmLinting dflags
+ if ncgAsmLinting config
then Color.validateGraph (text "")
False -- don't require nodes to be colored
graph_colored
@@ -289,7 +291,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree slotsCount debug_codeGrap
-- Ensure all the statistics are evaluated, to avoid space leaks.
seqList statList (return ())
- regAlloc_spin dflags (spinCount + 1) triv regsFree slotsFree'
+ regAlloc_spin config (spinCount + 1) triv regsFree slotsFree'
slotsCount' statList code_relive cfg
diff --git a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
index 05d2e814af..2285d3e908 100644
--- a/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Graph/Stats.hs
@@ -27,6 +27,7 @@ import GHC.CmmToAsm.Instr
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
import GHC.CmmToAsm.Reg.Target
+import GHC.Platform
import Outputable
import UniqFM
@@ -45,7 +46,11 @@ data RegAllocStats statics instr
, raGraph :: Color.Graph VirtualReg RegClass RealReg
-- | Information to help choose which regs to spill.
- , raSpillCosts :: SpillCostInfo }
+ , raSpillCosts :: SpillCostInfo
+
+ -- | Target platform
+ , raPlatform :: !Platform
+ }
-- Information about an intermediate graph.
@@ -98,23 +103,27 @@ data RegAllocStats statics instr
, raFinal :: [NatCmmDecl statics instr]
-- | Spill\/reload\/reg-reg moves present in this code.
- , raSRMs :: (Int, Int, Int) }
+ , raSRMs :: (Int, Int, Int)
+
+ -- | Target platform
+ , raPlatform :: !Platform
+ }
instance (Outputable statics, Outputable instr)
=> Outputable (RegAllocStats statics instr) where
- ppr (s@RegAllocStatsStart{}) = sdocWithPlatform $ \platform ->
- text "# Start"
+ ppr (s@RegAllocStatsStart{})
+ = text "# Start"
$$ text "# Native code with liveness information."
$$ ppr (raLiveCmm s)
$$ text ""
$$ text "# Initial register conflict graph."
$$ Color.dotGraph
- (targetRegDotColor platform)
- (trivColorable platform
- (targetVirtualRegSqueeze platform)
- (targetRealRegSqueeze platform))
+ (targetRegDotColor (raPlatform s))
+ (trivColorable (raPlatform s)
+ (targetVirtualRegSqueeze (raPlatform s))
+ (targetRealRegSqueeze (raPlatform s)))
(raGraph s)
@@ -140,8 +149,7 @@ instance (Outputable statics, Outputable instr)
ppr (s@RegAllocStatsColored { raSRMs = (spills, reloads, moves) })
- = sdocWithPlatform $ \platform ->
- text "# Colored"
+ = text "# Colored"
$$ text "# Code with liveness information."
$$ ppr (raCode s)
@@ -149,10 +157,10 @@ instance (Outputable statics, Outputable instr)
$$ text "# Register conflict graph (colored)."
$$ Color.dotGraph
- (targetRegDotColor platform)
- (trivColorable platform
- (targetVirtualRegSqueeze platform)
- (targetRealRegSqueeze platform))
+ (targetRegDotColor (raPlatform s))
+ (trivColorable (raPlatform s)
+ (targetVirtualRegSqueeze (raPlatform s))
+ (targetRealRegSqueeze (raPlatform s)))
(raGraphColored s)
$$ text ""
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear.hs b/compiler/GHC/CmmToAsm/Reg/Linear.hs
index 9b263889d8..155d67c2c2 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear.hs
@@ -119,6 +119,7 @@ import qualified GHC.CmmToAsm.Reg.Linear.X86_64 as X86_64
import GHC.CmmToAsm.Reg.Target
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Config
import GHC.Platform.Reg
import GHC.Cmm.BlockId
@@ -126,7 +127,6 @@ import GHC.Cmm.Dataflow.Collections
import GHC.Cmm hiding (RegSet)
import Digraph
-import GHC.Driver.Session
import Unique
import UniqSet
import UniqFM
@@ -144,7 +144,7 @@ import Control.Monad
-- Allocate registers
regAlloc
:: (Outputable instr, Instruction instr)
- => DynFlags
+ => NCGConfig
-> LiveCmmDecl statics instr
-> UniqSM ( NatCmmDecl statics instr
, Maybe Int -- number of extra stack slots required,
@@ -163,19 +163,19 @@ regAlloc _ (CmmProc (LiveInfo info _ _ _) lbl live [])
, Nothing
, Nothing )
-regAlloc dflags (CmmProc static lbl live sccs)
+regAlloc config (CmmProc static lbl live sccs)
| LiveInfo info entry_ids@(first_id:_) block_live _ <- static
= do
-- do register allocation on each component.
(final_blocks, stats, stack_use)
- <- linearRegAlloc dflags entry_ids block_live sccs
+ <- linearRegAlloc config entry_ids block_live sccs
-- make sure the block that was first in the input list
-- stays at the front of the output
let ((first':_), rest')
= partition ((== first_id) . blockId) final_blocks
- let max_spill_slots = maxSpillSlots dflags
+ let max_spill_slots = maxSpillSlots config
extra_stack
| stack_use > max_spill_slots
= Just (stack_use - max_spill_slots)
@@ -201,7 +201,7 @@ regAlloc _ (CmmProc _ _ _ _)
--
linearRegAlloc
:: (Outputable instr, Instruction instr)
- => DynFlags
+ => NCGConfig
-> [BlockId] -- ^ entry points
-> BlockMap RegSet
-- ^ live regs on entry to each basic block
@@ -209,7 +209,7 @@ linearRegAlloc
-- ^ instructions annotated with "deaths"
-> UniqSM ([NatBasicBlock instr], RegAllocStats, Int)
-linearRegAlloc dflags entry_ids block_live sccs
+linearRegAlloc config entry_ids block_live sccs
= case platformArch platform of
ArchX86 -> go $ (frInitFreeRegs platform :: X86.FreeRegs)
ArchX86_64 -> go $ (frInitFreeRegs platform :: X86_64.FreeRegs)
@@ -226,22 +226,22 @@ linearRegAlloc dflags entry_ids block_live sccs
ArchJavaScript -> panic "linearRegAlloc ArchJavaScript"
ArchUnknown -> panic "linearRegAlloc ArchUnknown"
where
- go f = linearRegAlloc' dflags f entry_ids block_live sccs
- platform = targetPlatform dflags
+ go f = linearRegAlloc' config f entry_ids block_live sccs
+ platform = ncgPlatform config
linearRegAlloc'
:: (FR freeRegs, Outputable instr, Instruction instr)
- => DynFlags
+ => NCGConfig
-> freeRegs
-> [BlockId] -- ^ entry points
-> BlockMap RegSet -- ^ live regs on entry to each basic block
-> [SCC (LiveBasicBlock instr)] -- ^ instructions annotated with "deaths"
-> UniqSM ([NatBasicBlock instr], RegAllocStats, Int)
-linearRegAlloc' dflags initFreeRegs entry_ids block_live sccs
+linearRegAlloc' config initFreeRegs entry_ids block_live sccs
= do us <- getUniqueSupplyM
let (_, stack, stats, blocks) =
- runR dflags mapEmpty initFreeRegs emptyRegMap (emptyStackMap dflags) us
+ runR config mapEmpty initFreeRegs emptyRegMap emptyStackMap us
$ linearRA_SCCs entry_ids block_live [] sccs
return (blocks, stats, getStackUse stack)
@@ -342,9 +342,8 @@ processBlock block_live (BasicBlock id instrs)
initBlock :: FR freeRegs
=> BlockId -> BlockMap RegSet -> RegM freeRegs ()
initBlock id block_live
- = do dflags <- getDynFlags
- let platform = targetPlatform dflags
- block_assig <- getBlockAssigR
+ = do platform <- getPlatform
+ block_assig <- getBlockAssigR
case mapLookup id block_assig of
-- no prior info about this block: we must consider
-- any fixed regs to be allocated, but we can ignore
@@ -487,8 +486,7 @@ genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)
-> RegM freeRegs ([instr], [NatBasicBlock instr])
genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
- dflags <- getDynFlags
- let platform = targetPlatform dflags
+ platform <- getPlatform
case regUsageOfInstr platform instr of { RU read written ->
do
let real_written = [ rr | (RegReal rr) <- written ]
@@ -590,8 +588,7 @@ genRaInsn block_live new_instrs block_id instr r_dying w_dying = do
releaseRegs :: FR freeRegs => [Reg] -> RegM freeRegs ()
releaseRegs regs = do
- dflags <- getDynFlags
- let platform = targetPlatform dflags
+ platform <- getPlatform
assig <- getAssigR
free <- getFreeRegsR
let loop assig !free [] = do setAssigR assig; setFreeRegsR free; return ()
@@ -651,8 +648,7 @@ saveClobberedTemps clobbered dying
= return (instrs, assig)
clobber assig instrs ((temp, reg) : rest)
- = do dflags <- getDynFlags
- let platform = targetPlatform dflags
+ = do platform <- getPlatform
freeRegs <- getFreeRegsR
let regclass = targetClassOfRealReg platform reg
@@ -693,10 +689,8 @@ clobberRegs []
= return ()
clobberRegs clobbered
- = do dflags <- getDynFlags
- let platform = targetPlatform dflags
-
- freeregs <- getFreeRegsR
+ = do platform <- getPlatform
+ freeregs <- getFreeRegsR
setFreeRegsR $! foldl' (flip $ frAllocateReg platform) freeregs clobbered
assig <- getAssigR
@@ -799,9 +793,8 @@ allocRegsAndSpill_spill :: (FR freeRegs, Instruction instr, Outputable instr)
-> SpillLoc
-> RegM freeRegs ([instr], [RealReg])
allocRegsAndSpill_spill reading keep spills alloc r rs assig spill_loc
- = do dflags <- getDynFlags
- let platform = targetPlatform dflags
- freeRegs <- getFreeRegsR
+ = do platform <- getPlatform
+ freeRegs <- getFreeRegsR
let freeRegs_thisClass = frGetFreeRegs platform (classOfVirtualReg r) freeRegs
case freeRegs_thisClass of
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
index 43dbab843b..92b3ee19a3 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/Base.hs
@@ -21,9 +21,9 @@ import GhcPrelude
import GHC.CmmToAsm.Reg.Linear.StackMap
import GHC.CmmToAsm.Reg.Liveness
+import GHC.CmmToAsm.Config
import GHC.Platform.Reg
-import GHC.Driver.Session
import Outputable
import Unique
import UniqFM
@@ -133,7 +133,9 @@ data RA_State freeRegs
-- Just keep a list here instead of a map of regs -> reasons.
-- We don't want to slow down the allocator if we're not going to emit the stats.
, ra_spills :: [SpillReason]
- , ra_DynFlags :: DynFlags
+
+ -- | Native code generator configuration
+ , ra_config :: !NCGConfig
-- | (from,fixup,to) : We inserted fixup code between from and to
, ra_fixups :: [(BlockId,BlockId,BlockId)] }
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs b/compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
index 0d72d8b6e9..e340dcf5c6 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/FreeRegs.hs
@@ -14,7 +14,7 @@ import GhcPrelude
import GHC.Platform.Reg
import GHC.Platform.Reg.Class
-import GHC.Driver.Session
+import GHC.CmmToAsm.Config
import Panic
import GHC.Platform
@@ -69,21 +69,19 @@ instance FR SPARC.FreeRegs where
frInitFreeRegs = SPARC.initFreeRegs
frReleaseReg = SPARC.releaseReg
-maxSpillSlots :: DynFlags -> Int
-maxSpillSlots dflags
- = case platformArch (targetPlatform dflags) of
- ArchX86 -> X86.Instr.maxSpillSlots dflags
- ArchX86_64 -> X86.Instr.maxSpillSlots dflags
- ArchPPC -> PPC.Instr.maxSpillSlots dflags
- ArchS390X -> panic "maxSpillSlots ArchS390X"
- ArchSPARC -> SPARC.Instr.maxSpillSlots dflags
- ArchSPARC64 -> panic "maxSpillSlots ArchSPARC64"
- ArchARM _ _ _ -> panic "maxSpillSlots ArchARM"
- ArchARM64 -> panic "maxSpillSlots ArchARM64"
- ArchPPC_64 _ -> PPC.Instr.maxSpillSlots dflags
- ArchAlpha -> panic "maxSpillSlots ArchAlpha"
- ArchMipseb -> panic "maxSpillSlots ArchMipseb"
- ArchMipsel -> panic "maxSpillSlots ArchMipsel"
- ArchJavaScript-> panic "maxSpillSlots ArchJavaScript"
- ArchUnknown -> panic "maxSpillSlots ArchUnknown"
-
+maxSpillSlots :: NCGConfig -> Int
+maxSpillSlots config = case platformArch (ncgPlatform config) of
+ ArchX86 -> X86.Instr.maxSpillSlots config
+ ArchX86_64 -> X86.Instr.maxSpillSlots config
+ ArchPPC -> PPC.Instr.maxSpillSlots config
+ ArchS390X -> panic "maxSpillSlots ArchS390X"
+ ArchSPARC -> SPARC.Instr.maxSpillSlots config
+ ArchSPARC64 -> panic "maxSpillSlots ArchSPARC64"
+ ArchARM _ _ _ -> panic "maxSpillSlots ArchARM"
+ ArchARM64 -> panic "maxSpillSlots ArchARM64"
+ ArchPPC_64 _ -> PPC.Instr.maxSpillSlots config
+ ArchAlpha -> panic "maxSpillSlots ArchAlpha"
+ ArchMipseb -> panic "maxSpillSlots ArchMipseb"
+ ArchMipsel -> panic "maxSpillSlots ArchMipsel"
+ ArchJavaScript-> panic "maxSpillSlots ArchJavaScript"
+ ArchUnknown -> panic "maxSpillSlots ArchUnknown"
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
index b4ad1b948c..0874cd0dbf 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/JoinToTargets.hs
@@ -17,12 +17,12 @@ import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Linear.FreeRegs
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Config
import GHC.Platform.Reg
import GHC.Cmm.BlockId
import GHC.Cmm.Dataflow.Collections
import Digraph
-import GHC.Driver.Session
import Outputable
import Unique
import UniqFM
@@ -125,8 +125,8 @@ joinToTargets_first block_live new_blocks block_id instr dest dests
block_assig src_assig
to_free
- = do dflags <- getDynFlags
- let platform = targetPlatform dflags
+ = do config <- getConfig
+ let platform = ncgPlatform config
-- free up the regs that are not live on entry to this block.
freeregs <- getFreeRegsR
@@ -355,8 +355,8 @@ makeMove
-> RegM freeRegs instr -- ^ move instruction.
makeMove delta vreg src dst
- = do dflags <- getDynFlags
- let platform = targetPlatform dflags
+ = do config <- getConfig
+ let platform = ncgPlatform config
case (src, dst) of
(InReg s, InReg d) ->
@@ -364,10 +364,10 @@ makeMove delta vreg src dst
return $ mkRegRegMoveInstr platform (RegReal s) (RegReal d)
(InMem s, InReg d) ->
do recordSpill (SpillJoinRM vreg)
- return $ mkLoadInstr dflags (RegReal d) delta s
+ return $ mkLoadInstr config (RegReal d) delta s
(InReg s, InMem d) ->
do recordSpill (SpillJoinRM vreg)
- return $ mkSpillInstr dflags (RegReal s) delta d
+ return $ mkSpillInstr config (RegReal s) delta d
_ ->
-- we don't handle memory to memory moves.
-- they shouldn't happen because we don't share
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs b/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
index 630b101fc7..00fcfd91c8 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/StackMap.hs
@@ -22,7 +22,6 @@ where
import GhcPrelude
-import GHC.Driver.Session
import UniqFM
import Unique
@@ -40,8 +39,8 @@ data StackMap
-- | An empty stack map, with all slots available.
-emptyStackMap :: DynFlags -> StackMap
-emptyStackMap _ = StackMap 0 emptyUFM
+emptyStackMap :: StackMap
+emptyStackMap = StackMap 0 emptyUFM
-- | If this vreg unique already has a stack assignment then return the slot number,
diff --git a/compiler/GHC/CmmToAsm/Reg/Linear/State.hs b/compiler/GHC/CmmToAsm/Reg/Linear/State.hs
index a167cc7e00..5a1e3a4c3f 100644
--- a/compiler/GHC/CmmToAsm/Reg/Linear/State.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Linear/State.hs
@@ -30,6 +30,8 @@ module GHC.CmmToAsm.Reg.Linear.State (
getDeltaR,
getUniqueR,
+ getConfig,
+ getPlatform,
recordSpill,
recordFixupBlock
@@ -43,10 +45,11 @@ import GHC.CmmToAsm.Reg.Linear.StackMap
import GHC.CmmToAsm.Reg.Linear.Base
import GHC.CmmToAsm.Reg.Liveness
import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.Config
import GHC.Platform.Reg
import GHC.Cmm.BlockId
-import GHC.Driver.Session
+import GHC.Platform
import Unique
import UniqSupply
@@ -79,12 +82,16 @@ instance Applicative (RegM freeRegs) where
instance Monad (RegM freeRegs) where
m >>= k = RegM $ \s -> case unReg m s of { RA_Result s a -> unReg (k a) s }
-instance HasDynFlags (RegM a) where
- getDynFlags = RegM $ \s -> RA_Result s (ra_DynFlags s)
+-- | Get native code generator configuration
+getConfig :: RegM a NCGConfig
+getConfig = RegM $ \s -> RA_Result s (ra_config s)
+-- | Get target platform from native code generator configuration
+getPlatform :: RegM a Platform
+getPlatform = ncgPlatform <$> getConfig
-- | Run a computation in the RegM register allocator monad.
-runR :: DynFlags
+runR :: NCGConfig
-> BlockAssignment freeRegs
-> freeRegs
-> RegMap Loc
@@ -93,7 +100,7 @@ runR :: DynFlags
-> RegM freeRegs a
-> (BlockAssignment freeRegs, StackMap, RegAllocStats, a)
-runR dflags block_assig freeregs assig stack us thing =
+runR config block_assig freeregs assig stack us thing =
case unReg thing
(RA_State
{ ra_blockassig = block_assig
@@ -103,7 +110,7 @@ runR dflags block_assig freeregs assig stack us thing =
, ra_stack = stack
, ra_us = us
, ra_spills = []
- , ra_DynFlags = dflags
+ , ra_config = config
, ra_fixups = [] })
of
RA_Result state returned_thing
@@ -121,10 +128,9 @@ makeRAStats state
spillR :: Instruction instr
=> Reg -> Unique -> RegM freeRegs (instr, Int)
-spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack0} ->
- let dflags = ra_DynFlags s
- (stack1,slot) = getStackSlotFor stack0 temp
- instr = mkSpillInstr dflags reg delta slot
+spillR reg temp = RegM $ \s ->
+ let (stack1,slot) = getStackSlotFor (ra_stack s) temp
+ instr = mkSpillInstr (ra_config s) reg (ra_delta s) slot
in
RA_Result s{ra_stack=stack1} (instr,slot)
@@ -132,9 +138,8 @@ spillR reg temp = RegM $ \ s@RA_State{ra_delta=delta, ra_stack=stack0} ->
loadR :: Instruction instr
=> Reg -> Int -> RegM freeRegs instr
-loadR reg slot = RegM $ \ s@RA_State{ra_delta=delta} ->
- let dflags = ra_DynFlags s
- in RA_Result s (mkLoadInstr dflags reg delta slot)
+loadR reg slot = RegM $ \s ->
+ RA_Result s (mkLoadInstr (ra_config s) reg (ra_delta s) slot)
getFreeRegsR :: RegM freeRegs freeRegs
getFreeRegsR = RegM $ \ s@RA_State{ra_freeregs = freeregs} ->
diff --git a/compiler/GHC/CmmToAsm/Reg/Liveness.hs b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
index 03b8123f93..d1c4c8f498 100644
--- a/compiler/GHC/CmmToAsm/Reg/Liveness.hs
+++ b/compiler/GHC/CmmToAsm/Reg/Liveness.hs
@@ -41,15 +41,15 @@ import GhcPrelude
import GHC.Platform.Reg
import GHC.CmmToAsm.Instr
+import GHC.CmmToAsm.CFG
+import GHC.CmmToAsm.Config
import GHC.Cmm.BlockId
-import GHC.CmmToAsm.CFG
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label
import GHC.Cmm hiding (RegSet, emptyRegSet)
import Digraph
-import GHC.Driver.Session
import MonadUtils
import Outputable
import GHC.Platform
@@ -483,11 +483,11 @@ slurpReloadCoalesce live
-- | Strip away liveness information, yielding NatCmmDecl
stripLive
:: (Outputable statics, Outputable instr, Instruction instr)
- => DynFlags
+ => NCGConfig
-> LiveCmmDecl statics instr
-> NatCmmDecl statics instr
-stripLive dflags live
+stripLive config live
= stripCmm live
where stripCmm :: (Outputable statics, Outputable instr, Instruction instr)
@@ -503,7 +503,7 @@ stripLive dflags live
= partition ((== first_id) . blockId) final_blocks
in CmmProc info label live
- (ListGraph $ map (stripLiveBlock dflags) $ first' : rest')
+ (ListGraph $ map (stripLiveBlock config) $ first' : rest')
-- If the proc has blocks but we don't know what the first one was, then we're dead.
stripCmm proc
@@ -514,11 +514,11 @@ stripLive dflags live
stripLiveBlock
:: Instruction instr
- => DynFlags
+ => NCGConfig
-> LiveBasicBlock instr
-> NatBasicBlock instr
-stripLiveBlock dflags (BasicBlock i lis)
+stripLiveBlock config (BasicBlock i lis)
= BasicBlock i instrs'
where (instrs', _)
@@ -529,11 +529,11 @@ stripLiveBlock dflags (BasicBlock i lis)
spillNat acc (LiveInstr (SPILL reg slot) _ : instrs)
= do delta <- get
- spillNat (mkSpillInstr dflags reg delta slot : acc) instrs
+ spillNat (mkSpillInstr config reg delta slot : acc) instrs
spillNat acc (LiveInstr (RELOAD slot reg) _ : instrs)
= do delta <- get
- spillNat (mkLoadInstr dflags reg delta slot : acc) instrs
+ spillNat (mkLoadInstr config reg delta slot : acc) instrs
spillNat acc (LiveInstr (Instr instr) _ : instrs)
| Just i <- takeDeltaInstr instr
View Lorry Controller Status