Commit ac21fdb4 authored by ian@well-typed.com's avatar ian@well-typed.com

Pass platform down to lastxmm

parent d182285f
......@@ -140,7 +140,7 @@ data NcgImpl statics instr jumpDest = NcgImpl {
shortcutJump :: (BlockId -> Maybe jumpDest) -> instr -> instr,
pprNatCmmDecl :: NatCmmDecl statics instr -> SDoc,
maxSpillSlots :: Int,
allocatableRegs :: [RealReg],
allocatableRegs :: Platform -> [RealReg],
ncg_x86fp_kludge :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
ncgExpandTop :: [NatCmmDecl statics instr] -> [NatCmmDecl statics instr],
ncgMakeFarBranches :: [NatBasicBlock instr] -> [NatBasicBlock instr]
......@@ -179,7 +179,7 @@ nativeCodeGen dflags h us cmms
,shortcutJump = PPC.RegInfo.shortcutJump
,pprNatCmmDecl = PPC.Ppr.pprNatCmmDecl
,maxSpillSlots = PPC.Instr.maxSpillSlots
,allocatableRegs = PPC.Regs.allocatableRegs
,allocatableRegs = \_ -> PPC.Regs.allocatableRegs
,ncg_x86fp_kludge = id
,ncgExpandTop = id
,ncgMakeFarBranches = makeFarBranches
......@@ -194,7 +194,7 @@ nativeCodeGen dflags h us cmms
,shortcutJump = SPARC.ShortcutJump.shortcutJump
,pprNatCmmDecl = SPARC.Ppr.pprNatCmmDecl
,maxSpillSlots = SPARC.Instr.maxSpillSlots
,allocatableRegs = SPARC.Regs.allocatableRegs
,allocatableRegs = \_ -> SPARC.Regs.allocatableRegs
,ncg_x86fp_kludge = id
,ncgExpandTop = map SPARC.CodeGen.Expand.expandTop
,ncgMakeFarBranches = id
......@@ -402,7 +402,7 @@ cmmNativeGen dflags ncgImpl us cmm count
let (withLiveness, usLive) =
{-# SCC "regLiveness" #-}
initUs usGen
$ mapM regLiveness
$ mapM (regLiveness platform)
$ map natCmmTopToLive native
dumpIfSet_dyn dflags
......@@ -419,7 +419,7 @@ cmmNativeGen dflags ncgImpl us cmm count
= foldr (\r -> plusUFM_C unionUniqSets
$ unitUFM (targetClassOfRealReg platform r) (unitUniqSet r))
emptyUFM
$ allocatableRegs ncgImpl
$ allocatableRegs ncgImpl platform
-- do the graph coloring register allocation
let ((alloced, regAllocStats), usAlloc)
......
......@@ -68,7 +68,8 @@ class Instruction instr where
-- allocation goes, are taken care of by the register allocator.
--
regUsageOfInstr
:: instr
:: Platform
-> instr
-> RegUsage
......
......@@ -177,8 +177,8 @@ data Instr
-- The consequences of control flow transfers, as far as register
-- allocation goes, are taken care of by the register allocator.
--
ppc_regUsageOfInstr :: Instr -> RegUsage
ppc_regUsageOfInstr instr
ppc_regUsageOfInstr :: Platform -> Instr -> RegUsage
ppc_regUsageOfInstr _ instr
= case instr of
LD _ reg addr -> usage (regAddr addr, [reg])
LA _ reg addr -> usage (regAddr addr, [reg])
......
......@@ -119,7 +119,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
-- build a map of the cost of spilling each instruction
-- this will only actually be computed if we have to spill something.
let spillCosts = foldl' plusSpillCostInfo zeroSpillCostInfo
$ map slurpSpillCostInfo code
$ map (slurpSpillCostInfo platform) code
-- the function to choose regs to leave uncolored
let spill = chooseSpill spillCosts
......@@ -213,13 +213,13 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code
-- spill the uncolored regs
(code_spilled, slotsFree', spillStats)
<- regSpill code_coalesced slotsFree rsSpill
<- regSpill platform code_coalesced slotsFree rsSpill
-- recalculate liveness
-- NOTE: we have to reverse the SCCs here to get them back into the reverse-dependency
-- order required by computeLiveness. If they're not in the correct order
-- that function will panic.
code_relive <- mapM (regLiveness . reverseBlocksInTops) code_spilled
code_relive <- mapM (regLiveness platform . reverseBlocksInTops) code_spilled
-- record what happened in this stage for debugging
let stat =
......
......@@ -20,6 +20,7 @@ import UniqFM
import UniqSet
import UniqSupply
import Outputable
import Platform
import Data.List
import Data.Maybe
......@@ -40,7 +41,8 @@ import qualified Data.Set as Set
--
regSpill
:: Instruction instr
=> [LiveCmmDecl statics instr] -- ^ the code
=> Platform
-> [LiveCmmDecl statics instr] -- ^ the code
-> UniqSet Int -- ^ available stack slots
-> UniqSet VirtualReg -- ^ the regs to spill
-> UniqSM
......@@ -48,7 +50,7 @@ regSpill
, UniqSet Int -- left over slots
, SpillStats ) -- stats about what happened during spilling
regSpill code slotsFree regs
regSpill platform code slotsFree regs
-- not enough slots to spill these regs
| sizeUniqSet slotsFree < sizeUniqSet regs
......@@ -68,7 +70,7 @@ regSpill code slotsFree regs
-- run the spiller on all the blocks
let (code', state') =
runState (mapM (regSpill_top regSlotMap) code)
runState (mapM (regSpill_top platform regSlotMap) code)
(initSpillS us)
return ( code'
......@@ -79,11 +81,12 @@ regSpill code slotsFree regs
-- | Spill some registers to stack slots in a top-level thing.
regSpill_top
:: Instruction instr
=> RegMap Int -- ^ map of vregs to slots they're being spilled to.
=> Platform
-> RegMap Int -- ^ map of vregs to slots they're being spilled to.
-> LiveCmmDecl statics instr -- ^ the top level thing.
-> SpillM (LiveCmmDecl statics instr)
regSpill_top regSlotMap cmm
regSpill_top platform regSlotMap cmm
= case cmm of
CmmData{}
-> return cmm
......@@ -110,7 +113,7 @@ regSpill_top regSlotMap cmm
liveSlotsOnEntry'
-- Apply the spiller to all the basic blocks in the CmmProc.
sccs' <- mapM (mapSCCM (regSpill_block regSlotMap)) sccs
sccs' <- mapM (mapSCCM (regSpill_block platform regSlotMap)) sccs
return $ CmmProc info' label sccs'
......@@ -137,12 +140,13 @@ regSpill_top regSlotMap cmm
-- | Spill some registers to stack slots in a basic block.
regSpill_block
:: Instruction instr
=> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
=> Platform
-> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
-> LiveBasicBlock instr
-> SpillM (LiveBasicBlock instr)
regSpill_block regSlotMap (BasicBlock i instrs)
= do instrss' <- mapM (regSpill_instr regSlotMap) instrs
regSpill_block platform regSlotMap (BasicBlock i instrs)
= do instrss' <- mapM (regSpill_instr platform regSlotMap) instrs
return $ BasicBlock i (concat instrss')
......@@ -151,18 +155,19 @@ regSpill_block regSlotMap (BasicBlock i instrs)
-- the appropriate RELOAD or SPILL meta instructions.
regSpill_instr
:: Instruction instr
=> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
=> Platform
-> UniqFM Int -- ^ map of vregs to slots they're being spilled to.
-> LiveInstr instr
-> SpillM [LiveInstr instr]
regSpill_instr _ li@(LiveInstr _ Nothing)
regSpill_instr _ _ li@(LiveInstr _ Nothing)
= do return [li]
regSpill_instr regSlotMap
regSpill_instr platform regSlotMap
(LiveInstr instr (Just _))
= do
-- work out which regs are read and written in this instr
let RU rlRead rlWritten = regUsageOfInstr instr
let RU rlRead rlWritten = regUsageOfInstr platform instr
-- sometimes a register is listed as being read more than once,
-- nub this so we don't end up inserting two lots of spill code.
......
......@@ -211,7 +211,7 @@ cleanForward platform blockId assoc acc (li : instrs)
-- writing to a reg changes its value.
| LiveInstr instr _ <- li
, RU _ written <- regUsageOfInstr instr
, RU _ written <- regUsageOfInstr platform instr
= let assoc' = foldr delAssoc assoc (map SReg $ nub written)
in cleanForward platform blockId assoc' (li : acc) instrs
......
......@@ -36,6 +36,7 @@ import UniqFM
import UniqSet
import Digraph (flattenSCCs)
import Outputable
import Platform
import State
import Data.List (nub, minimumBy)
......@@ -70,10 +71,11 @@ plusSpillCostRecord (r1, a1, b1, c1) (r2, a2, b2, c2)
-- and the number of instructions it was live on entry to (lifetime)
--
slurpSpillCostInfo :: (Outputable instr, Instruction instr)
=> LiveCmmDecl statics instr
=> Platform
-> LiveCmmDecl statics instr
-> SpillCostInfo
slurpSpillCostInfo cmm
slurpSpillCostInfo platform cmm
= execState (countCmm cmm) zeroSpillCostInfo
where
countCmm CmmData{} = return ()
......@@ -110,7 +112,7 @@ slurpSpillCostInfo cmm
mapM_ incLifetime $ uniqSetToList rsLiveEntry
-- increment counts for what regs were read/written from
let (RU read written) = regUsageOfInstr instr
let (RU read written) = regUsageOfInstr platform instr
mapM_ incUses $ catMaybes $ map takeVirtualReg $ nub read
mapM_ incDefs $ catMaybes $ map takeVirtualReg $ nub written
......
......@@ -44,7 +44,7 @@ import qualified X86.Instr
class Show freeRegs => FR freeRegs where
frAllocateReg :: RealReg -> freeRegs -> freeRegs
frGetFreeRegs :: RegClass -> freeRegs -> [RealReg]
frInitFreeRegs :: freeRegs
frInitFreeRegs :: Platform -> freeRegs
frReleaseReg :: RealReg -> freeRegs -> freeRegs
instance FR X86.FreeRegs where
......@@ -56,13 +56,13 @@ instance FR X86.FreeRegs where
instance FR PPC.FreeRegs where
frAllocateReg = PPC.allocateReg
frGetFreeRegs = PPC.getFreeRegs
frInitFreeRegs = PPC.initFreeRegs
frInitFreeRegs = \_ -> PPC.initFreeRegs
frReleaseReg = PPC.releaseReg
instance FR SPARC.FreeRegs where
frAllocateReg = SPARC.allocateReg
frGetFreeRegs = SPARC.getFreeRegs
frInitFreeRegs = SPARC.initFreeRegs
frInitFreeRegs = \_ -> SPARC.initFreeRegs
frReleaseReg = SPARC.releaseReg
maxSpillSlots :: Platform -> Int
......
......@@ -191,10 +191,10 @@ linearRegAlloc
linearRegAlloc dflags first_id block_live sccs
= let platform = targetPlatform dflags
in case platformArch platform of
ArchX86 -> linearRegAlloc' platform (frInitFreeRegs :: X86.FreeRegs) first_id block_live sccs
ArchX86_64 -> linearRegAlloc' platform (frInitFreeRegs :: X86.FreeRegs) first_id block_live sccs
ArchSPARC -> linearRegAlloc' platform (frInitFreeRegs :: SPARC.FreeRegs) first_id block_live sccs
ArchPPC -> linearRegAlloc' platform (frInitFreeRegs :: PPC.FreeRegs) first_id block_live sccs
ArchX86 -> linearRegAlloc' platform (frInitFreeRegs platform :: X86.FreeRegs) first_id block_live sccs
ArchX86_64 -> linearRegAlloc' platform (frInitFreeRegs platform :: X86.FreeRegs) first_id block_live sccs
ArchSPARC -> linearRegAlloc' platform (frInitFreeRegs platform :: SPARC.FreeRegs) first_id block_live sccs
ArchPPC -> linearRegAlloc' platform (frInitFreeRegs platform :: PPC.FreeRegs) first_id block_live sccs
ArchARM _ _ _ -> panic "linearRegAlloc ArchARM"
ArchPPC_64 -> panic "linearRegAlloc ArchPPC_64"
ArchUnknown -> panic "linearRegAlloc ArchUnknown"
......@@ -304,7 +304,7 @@ processBlock
-> RegM freeRegs [NatBasicBlock instr] -- ^ block with registers allocated
processBlock platform block_live (BasicBlock id instrs)
= do initBlock id block_live
= do initBlock platform id block_live
(instrs', fixups)
<- linearRA platform block_live [] [] id instrs
return $ BasicBlock id instrs' : fixups
......@@ -312,8 +312,9 @@ processBlock platform block_live (BasicBlock id instrs)
-- | Load the freeregs and current reg assignment into the RegM state
-- for the basic block with this BlockId.
initBlock :: FR freeRegs => BlockId -> BlockMap RegSet -> RegM freeRegs ()
initBlock id block_live
initBlock :: FR freeRegs
=> Platform -> BlockId -> BlockMap RegSet -> RegM freeRegs ()
initBlock platform id block_live
= do block_assig <- getBlockAssigR
case mapLookup id block_assig of
-- no prior info about this block: we must consider
......@@ -325,9 +326,9 @@ initBlock id block_live
-> do -- pprTrace "initFreeRegs" (text $ show initFreeRegs) (return ())
case mapLookup id block_live of
Nothing ->
setFreeRegsR frInitFreeRegs
setFreeRegsR (frInitFreeRegs platform)
Just live ->
setFreeRegsR $ foldr frAllocateReg frInitFreeRegs [ r | RegReal r <- uniqSetToList live ]
setFreeRegsR $ foldr frAllocateReg (frInitFreeRegs platform) [ r | RegReal r <- uniqSetToList live ]
setAssigR emptyRegMap
-- load info about register assignments leading into this block.
......@@ -447,7 +448,7 @@ genRaInsn :: (FR freeRegs, Instruction instr, Outputable instr)
-> RegM freeRegs ([instr], [NatBasicBlock instr])
genRaInsn platform block_live new_instrs block_id instr r_dying w_dying =
case regUsageOfInstr instr of { RU read written ->
case regUsageOfInstr platform instr of { RU read written ->
do
let real_written = [ rr | (RegReal rr) <- written ]
let virt_written = [ vr | (RegVirtual vr) <- written ]
......@@ -822,7 +823,7 @@ allocRegsAndSpill_spill platform reading keep spills alloc r rs assig spill_loc
[ text "allocating vreg: " <> text (show r)
, text "assignment: " <> text (show $ ufmToList assig)
, text "freeRegs: " <> text (show freeRegs)
, text "initFreeRegs: " <> text (show (frInitFreeRegs `asTypeOf` freeRegs)) ]
, text "initFreeRegs: " <> text (show (frInitFreeRegs platform `asTypeOf` freeRegs)) ]
result
......
......@@ -14,6 +14,7 @@ import X86.Regs
import RegClass
import Reg
import Panic
import Platform
import Data.Word
import Data.Bits
......@@ -35,9 +36,9 @@ releaseReg (RealRegSingle n) f
releaseReg _ _
= panic "RegAlloc.Linear.X86.FreeRegs.realeaseReg: no reg"
initFreeRegs :: FreeRegs
initFreeRegs
= foldr releaseReg noFreeRegs allocatableRegs
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
= foldr releaseReg noFreeRegs (allocatableRegs platform)
getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazilly
getFreeRegs cls f = go f 0
......
......@@ -87,9 +87,9 @@ data InstrSR instr
| RELOAD Int Reg
instance Instruction instr => Instruction (InstrSR instr) where
regUsageOfInstr i
regUsageOfInstr platform i
= case i of
Instr instr -> regUsageOfInstr instr
Instr instr -> regUsageOfInstr platform instr
SPILL reg _ -> RU [reg] []
RELOAD _ reg -> RU [] [reg]
......@@ -663,21 +663,22 @@ sccBlocks blocks = stronglyConnCompFromEdgedVertices graph
--
regLiveness
:: (Outputable instr, Instruction instr)
=> LiveCmmDecl statics instr
=> Platform
-> LiveCmmDecl statics instr
-> UniqSM (LiveCmmDecl statics instr)
regLiveness (CmmData i d)
regLiveness _ (CmmData i d)
= return $ CmmData i d
regLiveness (CmmProc info lbl [])
regLiveness _ (CmmProc info lbl [])
| LiveInfo static mFirst _ _ <- info
= return $ CmmProc
(LiveInfo static mFirst (Just mapEmpty) Map.empty)
lbl []
regLiveness (CmmProc info lbl sccs)
regLiveness platform (CmmProc info lbl sccs)
| LiveInfo static mFirst _ liveSlotsOnEntry <- info
= let (ann_sccs, block_live) = computeLiveness sccs
= let (ann_sccs, block_live) = computeLiveness platform sccs
in return $ CmmProc (LiveInfo static mFirst (Just block_live) liveSlotsOnEntry)
lbl ann_sccs
......@@ -742,15 +743,16 @@ reverseBlocksInTops top
--
computeLiveness
:: (Outputable instr, Instruction instr)
=> [SCC (LiveBasicBlock instr)]
=> Platform
-> [SCC (LiveBasicBlock instr)]
-> ([SCC (LiveBasicBlock instr)], -- instructions annotated with list of registers
-- which are "dead after this instruction".
BlockMap RegSet) -- blocks annontated with set of live registers
-- on entry to the block.
computeLiveness sccs
computeLiveness platform sccs
= case checkIsReverseDependent sccs of
Nothing -> livenessSCCs emptyBlockMap [] sccs
Nothing -> livenessSCCs platform emptyBlockMap [] sccs
Just bad -> pprPanic "RegAlloc.Liveness.computeLivenss"
(vcat [ text "SCCs aren't in reverse dependent order"
, text "bad blockId" <+> ppr bad
......@@ -758,22 +760,23 @@ computeLiveness sccs
livenessSCCs
:: Instruction instr
=> BlockMap RegSet
=> Platform
-> BlockMap RegSet
-> [SCC (LiveBasicBlock instr)] -- accum
-> [SCC (LiveBasicBlock instr)]
-> ( [SCC (LiveBasicBlock instr)]
, BlockMap RegSet)
livenessSCCs blockmap done []
livenessSCCs _ blockmap done []
= (done, blockmap)
livenessSCCs blockmap done (AcyclicSCC block : sccs)
= let (blockmap', block') = livenessBlock blockmap block
in livenessSCCs blockmap' (AcyclicSCC block' : done) sccs
livenessSCCs platform blockmap done (AcyclicSCC block : sccs)
= let (blockmap', block') = livenessBlock platform blockmap block
in livenessSCCs platform blockmap' (AcyclicSCC block' : done) sccs
livenessSCCs blockmap done
livenessSCCs platform blockmap done
(CyclicSCC blocks : sccs) =
livenessSCCs blockmap' (CyclicSCC blocks':done) sccs
livenessSCCs platform blockmap' (CyclicSCC blocks':done) sccs
where (blockmap', blocks')
= iterateUntilUnchanged linearLiveness equalBlockMaps
blockmap blocks
......@@ -796,7 +799,7 @@ livenessSCCs blockmap done
=> BlockMap RegSet -> [LiveBasicBlock instr]
-> (BlockMap RegSet, [LiveBasicBlock instr])
linearLiveness = mapAccumL livenessBlock
linearLiveness = mapAccumL (livenessBlock platform)
-- probably the least efficient way to compare two
-- BlockMaps for equality.
......@@ -812,17 +815,18 @@ livenessSCCs blockmap done
--
livenessBlock
:: Instruction instr
=> BlockMap RegSet
=> Platform
-> BlockMap RegSet
-> LiveBasicBlock instr
-> (BlockMap RegSet, LiveBasicBlock instr)
livenessBlock blockmap (BasicBlock block_id instrs)
livenessBlock platform blockmap (BasicBlock block_id instrs)
= let
(regsLiveOnEntry, instrs1)
= livenessBack emptyUniqSet blockmap [] (reverse instrs)
= livenessBack platform emptyUniqSet blockmap [] (reverse instrs)
blockmap' = mapInsert block_id regsLiveOnEntry blockmap
instrs2 = livenessForward regsLiveOnEntry instrs1
instrs2 = livenessForward platform regsLiveOnEntry instrs1
output = BasicBlock block_id instrs2
......@@ -833,16 +837,17 @@ livenessBlock blockmap (BasicBlock block_id instrs)
livenessForward
:: Instruction instr
=> RegSet -- regs live on this instr
=> Platform
-> RegSet -- regs live on this instr
-> [LiveInstr instr] -> [LiveInstr instr]
livenessForward _ [] = []
livenessForward rsLiveEntry (li@(LiveInstr instr mLive) : lis)
livenessForward _ _ [] = []
livenessForward platform rsLiveEntry (li@(LiveInstr instr mLive) : lis)
| Nothing <- mLive
= li : livenessForward rsLiveEntry lis
= li : livenessForward platform rsLiveEntry lis
| Just live <- mLive
, RU _ written <- regUsageOfInstr instr
, RU _ written <- regUsageOfInstr platform instr
= let
-- Regs that are written to but weren't live on entry to this instruction
-- are recorded as being born here.
......@@ -854,9 +859,9 @@ livenessForward rsLiveEntry (li@(LiveInstr instr mLive) : lis)
`minusUniqSet` (liveDieWrite live)
in LiveInstr instr (Just live { liveBorn = rsBorn })
: livenessForward rsLiveNext lis
: livenessForward platform rsLiveNext lis
livenessForward _ _ = panic "RegLiveness.livenessForward: no match"
livenessForward _ _ _ = panic "RegLiveness.livenessForward: no match"
-- | Calculate liveness going backwards,
......@@ -864,32 +869,34 @@ livenessForward _ _ = panic "RegLiveness.livenessForward: no match"
livenessBack
:: Instruction instr
=> RegSet -- regs live on this instr
=> Platform
-> RegSet -- regs live on this instr
-> BlockMap RegSet -- regs live on entry to other BBs
-> [LiveInstr instr] -- instructions (accum)
-> [LiveInstr instr] -- instructions
-> (RegSet, [LiveInstr instr])
livenessBack liveregs _ done [] = (liveregs, done)
livenessBack _ liveregs _ done [] = (liveregs, done)
livenessBack liveregs blockmap acc (instr : instrs)
= let (liveregs', instr') = liveness1 liveregs blockmap instr
in livenessBack liveregs' blockmap (instr' : acc) instrs
livenessBack platform liveregs blockmap acc (instr : instrs)
= let (liveregs', instr') = liveness1 platform liveregs blockmap instr
in livenessBack platform liveregs' blockmap (instr' : acc) instrs
-- don't bother tagging comments or deltas with liveness
liveness1
:: Instruction instr
=> RegSet
=> Platform
-> RegSet
-> BlockMap RegSet
-> LiveInstr instr
-> (RegSet, LiveInstr instr)
liveness1 liveregs _ (LiveInstr instr _)
liveness1 _ liveregs _ (LiveInstr instr _)
| isMetaInstr instr
= (liveregs, LiveInstr instr Nothing)
liveness1 liveregs blockmap (LiveInstr instr _)
liveness1 platform liveregs blockmap (LiveInstr instr _)
| not_a_branch
= (liveregs1, LiveInstr instr
......@@ -906,7 +913,7 @@ liveness1 liveregs blockmap (LiveInstr instr _)
, liveDieWrite = mkUniqSet w_dying }))
where
!(RU read written) = regUsageOfInstr instr
!(RU read written) = regUsageOfInstr platform instr
-- registers that were written here are dead going backwards.
-- registers that were read here are live going backwards.
......
......@@ -221,8 +221,8 @@ data Instr
-- consequences of control flow transfers, as far as register
-- allocation goes, are taken care of by the register allocator.
--
sparc_regUsageOfInstr :: Instr -> RegUsage
sparc_regUsageOfInstr instr
sparc_regUsageOfInstr :: Platform -> Instr -> RegUsage
sparc_regUsageOfInstr _ instr
= case instr of
LD _ addr reg -> usage (regAddr addr, [reg])
ST _ reg addr -> usage (reg : regAddr addr, [])
......
......@@ -320,8 +320,8 @@ data Operand
x86_regUsageOfInstr :: Instr -> RegUsage
x86_regUsageOfInstr instr
x86_regUsageOfInstr :: Platform -> Instr -> RegUsage
x86_regUsageOfInstr platform instr
= case instr of
MOV _ src dst -> usageRW src dst
MOVZxL _ src dst -> usageRW src dst
......@@ -359,8 +359,8 @@ x86_regUsageOfInstr instr
JXX_GBL _ _ -> mkRU [] []
JMP op regs -> mkRUR (use_R op regs)
JMP_TBL op _ _ _ -> mkRUR (use_R op [])
CALL (Left _) params -> mkRU params callClobberedRegs
CALL (Right reg) params -> mkRU (reg:params) callClobberedRegs
CALL (Left _) params -> mkRU params (callClobberedRegs platform)
CALL (Right reg) params -> mkRU (reg:params) (callClobberedRegs platform)
CLTD _ -> mkRU [eax] [edx]
NOP -> mkRU [] []
......
......@@ -230,13 +230,13 @@ firstfake, lastfake :: RegNo
firstfake = 16
lastfake = 21
firstxmm, lastxmm :: RegNo
firstxmm :: RegNo
firstxmm = 24
#if i386_TARGET_ARCH
lastxmm = 31
#else
lastxmm = 39
#endif
lastxmm :: Platform -> RegNo
lastxmm platform
| target32Bit platform = 31
| otherwise = 39
lastint :: RegNo
#if i386_TARGET_ARCH
......@@ -245,11 +245,15 @@ lastint = 7 -- not %r8..%r15
lastint = 15
#endif
intregnos, fakeregnos, xmmregnos, floatregnos :: [RegNo]
intregnos, fakeregnos :: [RegNo]
intregnos = [0..lastint]
fakeregnos = [firstfake .. lastfake]
xmmregnos = [firstxmm .. lastxmm]
floatregnos = fakeregnos ++ xmmregnos;
xmmregnos :: Platform -> [RegNo]
xmmregnos platform = [firstxmm .. lastxmm platform]
floatregnos :: Platform -> [RegNo]
floatregnos platform = fakeregnos ++ xmmregnos platform
-- argRegs is the set of regs which are read for an n-argument call to C.
......@@ -259,8 +263,8 @@ argRegs :: RegNo -> [Reg]
argRegs _ = panic "MachRegs.argRegs(x86): should not be used!"
-- | The complete set of machine registers.
allMachRegNos :: [RegNo]
allMachRegNos = intregnos ++ floatregnos
allMachRegNos :: Platform -> [RegNo]
allMachRegNos platform = intregnos ++ floatregnos platform
-- | Take the class of a register.
{-# INLINE classOfRealReg #-}
......@@ -420,7 +424,7 @@ globalRegMaybe :: GlobalReg -> Maybe RealReg
allArgRegs :: [(Reg, Reg)]
allIntArgRegs :: [Reg]
allFPArgRegs :: [Reg]