Split Reg into vreg/hreg and add register pairs

 * The old Reg type is now split into VirtualReg and RealReg.
 * For the graph coloring allocator, the type of the register graph
   is now (Graph VirtualReg RegClass RealReg), which shows that it colors
   in nodes representing virtual regs with colors representing real regs.
   (as was intended)  
 * RealReg contains two contructors, RealRegSingle and RealRegPair,
   where RealRegPair is used to represent a SPARC double reg 
   constructed from two single precision FP regs. 
 * On SPARC we can now allocate double regs into an arbitrary register
   pair, instead of reserving some reg ranges to only hold float/double values. 
parent de29a9f0
......@@ -505,6 +505,7 @@ Library
SPARC.CodeGen.Gen32
SPARC.CodeGen.Gen64
SPARC.CodeGen.Sanity
SPARC.CodeGen.Expand
RegAlloc.Liveness
RegAlloc.Graph.Main
RegAlloc.Graph.Stats
......
......@@ -120,6 +120,7 @@ data DynFlag
| Opt_D_dump_asm_regalloc_stages
| Opt_D_dump_asm_conflicts
| Opt_D_dump_asm_stats
| Opt_D_dump_asm_expanded
| Opt_D_dump_cpranal
| Opt_D_dump_deriv
| Opt_D_dump_ds
......@@ -1360,6 +1361,8 @@ dynamic_flags = [
Supported
, Flag "ddump-asm-stats" (setDumpFlag Opt_D_dump_asm_stats)
Supported
, Flag "ddump-asm-expanded" (setDumpFlag Opt_D_dump_asm_expanded)
Supported
, Flag "ddump-cpranal" (setDumpFlag Opt_D_dump_cpranal)
Supported
, Flag "ddump-deriv" (setDumpFlag Opt_D_dump_deriv)
......
......@@ -62,12 +62,14 @@ import qualified RegAlloc.Graph.Stats as Color
import qualified RegAlloc.Graph.Coalesce as Color
import qualified RegAlloc.Graph.TrivColorable as Color
import qualified TargetReg as Target
import qualified SPARC.CodeGen.Expand as SPARC
import TargetReg
import Platform
import Instruction
import PIC
import Reg
import RegClass
import NCGMonad
import Cmm
......@@ -195,7 +197,11 @@ nativeCodeGen dflags h us cmms
dumpIfSet_dyn dflags
Opt_D_dump_asm_conflicts "Register conflict graph"
$ Color.dotGraph Target.targetRegDotColor (Color.trivColorable Target.targetRegClass)
$ Color.dotGraph
targetRegDotColor
(Color.trivColorable
targetVirtualRegSqueeze
targetRealRegSqueeze)
$ graphGlobal)
......@@ -311,13 +317,14 @@ cmmNativeGen dflags us cmm count
|| dopt Opt_RegsIterative dflags)
then do
-- the regs usable for allocation
let alloc_regs
let (alloc_regs :: UniqFM (UniqSet RealReg))
= foldr (\r -> plusUFM_C unionUniqSets
$ unitUFM (regClass r) (unitUniqSet r))
$ unitUFM (targetClassOfRealReg r) (unitUniqSet r))
emptyUFM
$ map RealReg allocatableRegs
$ allocatableRegs
-- graph coloring register allocation
-- do the graph coloring register allocation
let ((alloced, regAllocStats), usAlloc)
= {-# SCC "RegAlloc" #-}
initUs usLive
......@@ -385,7 +392,7 @@ cmmNativeGen dflags us cmm count
map sequenceTop shorted
---- x86fp_kludge
let final_mach_code =
let kludged =
#if i386_TARGET_ARCH
{-# SCC "x86fp_kludge" #-}
map x86fp_kludge sequenced
......@@ -393,8 +400,22 @@ cmmNativeGen dflags us cmm count
sequenced
#endif
---- expansion of SPARC synthetic instrs
#if sparc_TARGET_ARCH
let expanded =
{-# SCC "sparc_expand" #-}
map SPARC.expandTop kludged
dumpIfSet_dyn dflags
Opt_D_dump_asm_expanded "Synthetic instructions expanded"
(vcat $ map (docToSDoc . pprNatCmmTop) expanded)
#else
let expanded =
kludged
#endif
return ( usAlloc
, final_mach_code
, expanded
, lastMinuteImports ++ imports
, ppr_raStatsColor
, ppr_raStatsLinear)
......
......@@ -132,14 +132,16 @@ getNewLabelNat
getNewRegNat :: Size -> NatM Reg
getNewRegNat rep
= do u <- getUniqueNat
return (targetMkVReg u rep)
return (RegVirtual $ targetMkVirtualReg u rep)
getNewRegPairNat :: Size -> NatM (Reg,Reg)
getNewRegPairNat rep
= do u <- getUniqueNat
let lo = targetMkVReg u rep; hi = getHiVRegFromLo lo
return (lo,hi)
let vLo = targetMkVirtualReg u rep
let lo = RegVirtual $ targetMkVirtualReg u rep
let hi = RegVirtual $ getHiVirtualRegFromLo vLo
return (lo, hi)
getPicBaseMaybeNat :: NatM (Maybe Reg)
......
......@@ -180,7 +180,7 @@ getRegisterReg (CmmLocal (LocalReg u pk))
getRegisterReg (CmmGlobal mid)
= case get_GlobalReg_reg_or_addr mid of
Left (RealReg rrno) -> RealReg rrno
Left reg@(RegReal _) -> reg
_other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
-- By this stage, the only MagicIds remaining should be the
-- ones which map to a real machine register on this
......
......@@ -230,12 +230,12 @@ ppc_regUsageOfInstr instr
regRI _ = []
interesting :: Reg -> Bool
interesting (VirtualRegI _) = True
interesting (VirtualRegHi _) = True
interesting (VirtualRegF _) = True
interesting (VirtualRegD _) = True
interesting (RealReg i) = isFastTrue (freeReg i)
interesting (RegVirtual _) = True
interesting (RegReal (RealRegSingle i))
= isFastTrue (freeReg i)
interesting (RegReal (RealRegPair{}))
= panic "PPC.Instr.interesting: no reg pairs on this arch"
......
......@@ -164,11 +164,12 @@ pprReg :: Reg -> Doc
pprReg r
= case r of
RealReg i -> ppr_reg_no i
VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
RegReal (RealRegSingle i) -> ppr_reg_no i
RegReal (RealRegPair{}) -> panic "PPC.pprReg: no reg pairs on this arch"
RegVirtual (VirtualRegI u) -> text "%vI_" <> asmSDoc (pprUnique u)
RegVirtual (VirtualRegHi u) -> text "%vHi_" <> asmSDoc (pprUnique u)
RegVirtual (VirtualRegF u) -> text "%vF_" <> asmSDoc (pprUnique u)
RegVirtual (VirtualRegD u) -> text "%vD_" <> asmSDoc (pprUnique u)
where
#if darwin_TARGET_OS
ppr_reg_no :: Int -> Doc
......
......@@ -37,11 +37,11 @@ import Unique
mkVReg :: Unique -> Size -> Reg
mkVReg u size
| not (isFloatSize size) = VirtualRegI u
| not (isFloatSize size) = RegVirtual $ VirtualRegI u
| otherwise
= case size of
FF32 -> VirtualRegD u
FF64 -> VirtualRegD u
FF32 -> RegVirtual $ VirtualRegD u
FF64 -> RegVirtual $ VirtualRegD u
_ -> panic "mkVReg"
......
......@@ -138,30 +138,30 @@ spRel n = AddrRegImm sp (ImmInt (n * wORD_SIZE))
-- Dunno about Alpha.
argRegs :: RegNo -> [Reg]
argRegs 0 = []
argRegs 1 = map RealReg [3]
argRegs 2 = map RealReg [3,4]
argRegs 3 = map RealReg [3..5]
argRegs 4 = map RealReg [3..6]
argRegs 5 = map RealReg [3..7]
argRegs 6 = map RealReg [3..8]
argRegs 7 = map RealReg [3..9]
argRegs 8 = map RealReg [3..10]
argRegs 1 = map regSingle [3]
argRegs 2 = map regSingle [3,4]
argRegs 3 = map regSingle [3..5]
argRegs 4 = map regSingle [3..6]
argRegs 5 = map regSingle [3..7]
argRegs 6 = map regSingle [3..8]
argRegs 7 = map regSingle [3..9]
argRegs 8 = map regSingle [3..10]
argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"
allArgRegs :: [Reg]
allArgRegs = map RealReg [3..10]
allArgRegs = map regSingle [3..10]
-- these are the regs which we cannot assume stay alive over a C call.
callClobberedRegs :: [Reg]
#if defined(darwin_TARGET_OS)
callClobberedRegs
= map RealReg (0:[2..12] ++ map fReg [0..13])
= map regSingle (0:[2..12] ++ map fReg [0..13])
#elif defined(linux_TARGET_OS)
callClobberedRegs
= map RealReg (0:[2..13] ++ map fReg [0..13])
= map regSingle (0:[2..13] ++ map fReg [0..13])
#else
callClobberedRegs
......@@ -175,14 +175,17 @@ allMachRegNos = [0..63]
{-# INLINE regClass #-}
regClass :: Reg -> RegClass
regClass (VirtualRegI _) = RcInteger
regClass (VirtualRegHi _) = RcInteger
regClass (VirtualRegF u) = pprPanic ("regClass(ppc):VirtualRegF ") (ppr u)
regClass (VirtualRegD _) = RcDouble
regClass (RealReg i)
regClass (RegVirtual (VirtualRegI _)) = RcInteger
regClass (RegVirtual (VirtualRegHi _)) = RcInteger
regClass (RegVirtual (VirtualRegF u)) = pprPanic ("regClass(ppc):VirtualRegF ") (ppr u)
regClass (RegVirtual (VirtualRegD _)) = RcDouble
regClass (RegReal (RealRegSingle i))
| i < 32 = RcInteger
| otherwise = RcDouble
regClass (RegReal (RealRegPair{}))
= panic "regClass(ppr): no reg pairs on this architecture"
showReg :: RegNo -> String
showReg n
......@@ -196,10 +199,10 @@ showReg n
allFPArgRegs :: [Reg]
#if defined(darwin_TARGET_OS)
allFPArgRegs = map (RealReg . fReg) [1..13]
allFPArgRegs = map (regSingle . fReg) [1..13]
#elif defined(linux_TARGET_OS)
allFPArgRegs = map (RealReg . fReg) [1..8]
allFPArgRegs = map (regSingle . fReg) [1..8]
#else
allFPArgRegs = panic "PPC.Regs.allFPArgRegs: not defined for this architecture"
......@@ -240,14 +243,14 @@ fReg :: Int -> RegNo
fReg x = (32 + x)
sp, r3, r4, r27, r28, f1, f20, f21 :: Reg
sp = RealReg 1
r3 = RealReg 3
r4 = RealReg 4
r27 = RealReg 27
r28 = RealReg 28
f1 = RealReg $ fReg 1
f20 = RealReg $ fReg 20
f21 = RealReg $ fReg 21
sp = regSingle 1
r3 = regSingle 3
r4 = regSingle 4
r27 = regSingle 27
r28 = regSingle 28
f1 = regSingle $ fReg 1
f20 = regSingle $ fReg 20
f21 = regSingle $ fReg 21
......@@ -436,79 +439,79 @@ freeReg _ = fastBool True
#ifdef REG_Base
globalRegMaybe BaseReg = Just (RealReg REG_Base)
globalRegMaybe BaseReg = Just (regSingle REG_Base)
#endif
#ifdef REG_R1
globalRegMaybe (VanillaReg 1 _) = Just (RealReg REG_R1)
globalRegMaybe (VanillaReg 1 _) = Just (regSingle REG_R1)
#endif
#ifdef REG_R2
globalRegMaybe (VanillaReg 2 _) = Just (RealReg REG_R2)
globalRegMaybe (VanillaReg 2 _) = Just (regSingle REG_R2)
#endif
#ifdef REG_R3
globalRegMaybe (VanillaReg 3 _) = Just (RealReg REG_R3)
globalRegMaybe (VanillaReg 3 _) = Just (regSingle REG_R3)
#endif
#ifdef REG_R4
globalRegMaybe (VanillaReg 4 _) = Just (RealReg REG_R4)
globalRegMaybe (VanillaReg 4 _) = Just (regSingle REG_R4)
#endif
#ifdef REG_R5
globalRegMaybe (VanillaReg 5 _) = Just (RealReg REG_R5)
globalRegMaybe (VanillaReg 5 _) = Just (regSingle REG_R5)
#endif
#ifdef REG_R6
globalRegMaybe (VanillaReg 6 _) = Just (RealReg REG_R6)
globalRegMaybe (VanillaReg 6 _) = Just (regSingle REG_R6)
#endif
#ifdef REG_R7
globalRegMaybe (VanillaReg 7 _) = Just (RealReg REG_R7)
globalRegMaybe (VanillaReg 7 _) = Just (regSingle REG_R7)
#endif
#ifdef REG_R8
globalRegMaybe (VanillaReg 8 _) = Just (RealReg REG_R8)
globalRegMaybe (VanillaReg 8 _) = Just (regSingle REG_R8)
#endif
#ifdef REG_R9
globalRegMaybe (VanillaReg 9 _) = Just (RealReg REG_R9)
globalRegMaybe (VanillaReg 9 _) = Just (regSingle REG_R9)
#endif
#ifdef REG_R10
globalRegMaybe (VanillaReg 10 _) = Just (RealReg REG_R10)
globalRegMaybe (VanillaReg 10 _) = Just (regSingle REG_R10)
#endif
#ifdef REG_F1
globalRegMaybe (FloatReg 1) = Just (RealReg REG_F1)
globalRegMaybe (FloatReg 1) = Just (regSingle REG_F1)
#endif
#ifdef REG_F2
globalRegMaybe (FloatReg 2) = Just (RealReg REG_F2)
globalRegMaybe (FloatReg 2) = Just (regSingle REG_F2)
#endif
#ifdef REG_F3
globalRegMaybe (FloatReg 3) = Just (RealReg REG_F3)
globalRegMaybe (FloatReg 3) = Just (regSingle REG_F3)
#endif
#ifdef REG_F4
globalRegMaybe (FloatReg 4) = Just (RealReg REG_F4)
globalRegMaybe (FloatReg 4) = Just (regSingle REG_F4)
#endif
#ifdef REG_D1
globalRegMaybe (DoubleReg 1) = Just (RealReg REG_D1)
globalRegMaybe (DoubleReg 1) = Just (regSingle REG_D1)
#endif
#ifdef REG_D2
globalRegMaybe (DoubleReg 2) = Just (RealReg REG_D2)
globalRegMaybe (DoubleReg 2) = Just (regSingle REG_D2)
#endif
#ifdef REG_Sp
globalRegMaybe Sp = Just (RealReg REG_Sp)
globalRegMaybe Sp = Just (regSingle REG_Sp)
#endif
#ifdef REG_Lng1
globalRegMaybe (LongReg 1) = Just (RealReg REG_Lng1)
globalRegMaybe (LongReg 1) = Just (regSingle REG_Lng1)
#endif
#ifdef REG_Lng2
globalRegMaybe (LongReg 2) = Just (RealReg REG_Lng2)
globalRegMaybe (LongReg 2) = Just (regSingle REG_Lng2)
#endif
#ifdef REG_SpLim
globalRegMaybe SpLim = Just (RealReg REG_SpLim)
globalRegMaybe SpLim = Just (regSingle REG_SpLim)
#endif
#ifdef REG_Hp
globalRegMaybe Hp = Just (RealReg REG_Hp)
globalRegMaybe Hp = Just (regSingle REG_Hp)
#endif
#ifdef REG_HpLim
globalRegMaybe HpLim = Just (RealReg REG_HpLim)
globalRegMaybe HpLim = Just (regSingle REG_HpLim)
#endif
#ifdef REG_CurrentTSO
globalRegMaybe CurrentTSO = Just (RealReg REG_CurrentTSO)
globalRegMaybe CurrentTSO = Just (regSingle REG_CurrentTSO)
#endif
#ifdef REG_CurrentNursery
globalRegMaybe CurrentNursery = Just (RealReg REG_CurrentNursery)
globalRegMaybe CurrentNursery = Just (regSingle REG_CurrentNursery)
#endif
globalRegMaybe _ = Nothing
......
......@@ -7,11 +7,22 @@
module Reg (
RegNo,
Reg(..),
isRealReg,
unRealReg,
isVirtualReg,
regPair,
regSingle,
isRealReg, takeRealReg,
isVirtualReg, takeVirtualReg,
VirtualReg(..),
renameVirtualReg,
getHiVRegFromLo
classOfVirtualReg,
getHiVirtualRegFromLo,
getHiVRegFromLo,
RealReg(..),
regNosOfRealReg,
realRegsAlias,
liftPatchFnToRegReg
)
where
......@@ -19,15 +30,13 @@ where
import Outputable
import Unique
import Panic
import RegClass
import Data.List
-- | An identifier for a real machine register.
-- | An identifier for a primitive real machine register.
type RegNo
= Int
-- RealRegs are machine regs which are available for allocation, in
-- the usual way. We know what class they are, because that's part of
-- the processor's architecture.
-- VirtualRegs are virtual registers. The register allocator will
-- eventually have to map them into RealRegs, or into spill slots.
--
......@@ -35,79 +44,173 @@ type RegNo
-- value in the abstract assembly code (i.e. dynamic registers are
-- usually single assignment).
--
-- With the new register allocator, the
-- single assignment restriction isn't necessary to get correct code,
-- The single assignment restriction isn't necessary to get correct code,
-- although a better register allocation will result if single
-- assignment is used -- because the allocator maps a VirtualReg into
-- a single RealReg, even if the VirtualReg has multiple live ranges.
--
-- Virtual regs can be of either class, so that info is attached.
data Reg
= RealReg {-# UNPACK #-} !RegNo
| VirtualRegI {-# UNPACK #-} !Unique
--
data VirtualReg
= VirtualRegI {-# UNPACK #-} !Unique
| VirtualRegHi {-# UNPACK #-} !Unique -- High part of 2-word register
| VirtualRegF {-# UNPACK #-} !Unique
| VirtualRegD {-# UNPACK #-} !Unique
deriving (Eq, Ord)
-- We like to have Uniques for Reg so that we can make UniqFM and UniqSets
-- in the register allocator.
instance Uniquable Reg where
getUnique (RealReg i) = mkUnique 'C' i
getUnique (VirtualRegI u) = u
getUnique (VirtualRegHi u) = u
getUnique (VirtualRegF u) = u
getUnique (VirtualRegD u) = u
deriving (Eq, Show, Ord)
instance Uniquable VirtualReg where
getUnique reg
= case reg of
VirtualRegI u -> u
VirtualRegHi u -> u
VirtualRegF u -> u
VirtualRegD u -> u
-- | Print a reg in a generic manner
-- If you want the architecture specific names, then use the pprReg
-- function from the appropriate Ppr module.
instance Outputable Reg where
instance Outputable VirtualReg where
ppr reg
= case reg of
RealReg i -> text "%r" <> int i
VirtualRegI u -> text "%vI_" <> pprUnique u
VirtualRegHi u -> text "%vHi_" <> pprUnique u
VirtualRegF u -> text "%vF_" <> pprUnique u
VirtualRegD u -> text "%vD_" <> pprUnique u
isRealReg :: Reg -> Bool
isRealReg = not . isVirtualReg
-- | Take the RegNo from a real reg
unRealReg :: Reg -> RegNo
unRealReg (RealReg i) = i
unRealReg _ = panic "unRealReg on VirtualReg"
isVirtualReg :: Reg -> Bool
isVirtualReg (RealReg _) = False
isVirtualReg (VirtualRegI _) = True
isVirtualReg (VirtualRegHi _) = True
isVirtualReg (VirtualRegF _) = True
isVirtualReg (VirtualRegD _) = True
renameVirtualReg :: Unique -> Reg -> Reg
renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
renameVirtualReg u r
= case r of
RealReg _ -> error "renameVirtualReg: can't change unique on a real reg"
VirtualRegI _ -> VirtualRegI u
VirtualRegHi _ -> VirtualRegHi u
VirtualRegF _ -> VirtualRegF u
VirtualRegD _ -> VirtualRegD u
classOfVirtualReg :: VirtualReg -> RegClass
classOfVirtualReg vr
= case vr of
VirtualRegI{} -> RcInteger
VirtualRegHi{} -> RcInteger
VirtualRegF{} -> RcFloat
VirtualRegD{} -> RcDouble
-- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform
-- when supplied with the vreg for the lower-half of the quantity.
-- (NB. Not reversible).
getHiVirtualRegFromLo :: VirtualReg -> VirtualReg
getHiVirtualRegFromLo reg
= case reg of
-- makes a pseudo-unique with tag 'H'
VirtualRegI u -> VirtualRegHi (newTagUnique u 'H')
_ -> panic "Reg.getHiVirtualRegFromLo"
getHiVRegFromLo :: Reg -> Reg
getHiVRegFromLo (VirtualRegI u)
= VirtualRegHi (newTagUnique u 'H') -- makes a pseudo-unique with tag 'H'
getHiVRegFromLo reg
= case reg of
RegVirtual vr -> RegVirtual (getHiVirtualRegFromLo vr)
RegReal _ -> panic "Reg.getHiVRegFromLo"
------------------------------------------------------------------------------------
-- | RealRegs are machine regs which are available for allocation, in
-- the usual way. We know what class they are, because that's part of
-- the processor's architecture.
--
-- RealRegPairs are pairs of real registers that are allocated together
-- to hold a larger value, such as with Double regs on SPARC.
--
data RealReg
= RealRegSingle {-# UNPACK #-} !RegNo
| RealRegPair {-# UNPACK #-} !RegNo {-# UNPACK #-} !RegNo
deriving (Eq, Show, Ord)
instance Uniquable RealReg where
getUnique reg
= case reg of
RealRegSingle i -> mkUnique 'S' i
RealRegPair r1 r2 -> mkUnique 'P' (r1 * 65536 + r2)
instance Outputable RealReg where
ppr reg
= case reg of
RealRegSingle i -> text "%r" <> int i
RealRegPair r1 r2 -> text "%r(" <> int r1 <> text "|" <> int r2 <> text ")"
regNosOfRealReg :: RealReg -> [RegNo]
regNosOfRealReg rr
= case rr of
RealRegSingle r1 -> [r1]
RealRegPair r1 r2 -> [r1, r2]
realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias rr1 rr2
= not $ null $ intersect (regNosOfRealReg rr1) (regNosOfRealReg rr2)
--------------------------------------------------------------------------------
-- | A register, either virtual or real
data Reg
= RegVirtual {-# UNPACK #-} !VirtualReg
| RegReal {-# UNPACK #-} !RealReg
deriving (Eq, Ord)
getHiVRegFromLo _
= panic "RegsBase.getHiVRegFromLo"
regSingle :: RegNo -> Reg
regSingle regNo = RegReal $ RealRegSingle regNo
regPair :: RegNo -> RegNo -> Reg
regPair regNo1 regNo2 = RegReal $ RealRegPair regNo1 regNo2
-- We like to have Uniques for Reg so that we can make UniqFM and UniqSets
-- in the register allocator.
instance Uniquable Reg where
getUnique reg
= case reg of
RegVirtual vr -> getUnique vr
RegReal rr -> getUnique rr
-- | Print a reg in a generic manner
-- If you want the architecture specific names, then use the pprReg
-- function from the appropriate Ppr module.
instance Outputable Reg where
ppr reg
= case reg of
RegVirtual vr -> ppr vr
RegReal rr -> ppr rr
isRealReg :: Reg -> Bool
isRealReg reg
= case reg of
RegReal _ -> True