summaryrefslogtreecommitdiff
path: root/compiler/nativeGen/PPC
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/nativeGen/PPC')
-rw-r--r--compiler/nativeGen/PPC/CodeGen.hs11
-rw-r--r--compiler/nativeGen/PPC/Instr.hs5
-rw-r--r--compiler/nativeGen/PPC/Ppr.hs3
-rw-r--r--compiler/nativeGen/PPC/RegInfo.hs29
-rw-r--r--compiler/nativeGen/PPC/Regs.hs114
5 files changed, 113 insertions, 49 deletions
diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs
index d3ec27f45c..8eb515e6bf 100644
--- a/compiler/nativeGen/PPC/CodeGen.hs
+++ b/compiler/nativeGen/PPC/CodeGen.hs
@@ -35,6 +35,7 @@ import PIC
import Size
import RegClass
import Reg
+import TargetReg
import Platform
-- Our intermediate code:
@@ -176,11 +177,11 @@ swizzleRegisterRep (Any _ codefn) size = Any size codefn
getRegisterReg :: CmmReg -> Reg
getRegisterReg (CmmLocal (LocalReg u pk))
- = mkVReg u (cmmTypeSize pk)
+ = RegVirtual $ mkVirtualReg u (cmmTypeSize pk)
getRegisterReg (CmmGlobal mid)
= case get_GlobalReg_reg_or_addr mid of
- Left reg@(RegReal _) -> reg
+ Left reg -> 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
@@ -305,7 +306,7 @@ assignReg_I64Code :: CmmReg -> CmmExpr -> NatM InstrBlock
assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
let
- r_dst_lo = mkVReg u_dst II32
+ r_dst_lo = RegVirtual $ mkVirtualReg u_dst II32
r_dst_hi = getHiVRegFromLo r_dst_lo
r_src_hi = getHiVRegFromLo r_src_lo
mov_lo = MR r_dst_lo r_src_lo
@@ -329,7 +330,7 @@ iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
rlo
iselExpr64 (CmmReg (CmmLocal (LocalReg vu ty))) | isWord64 ty
- = return (ChildCode64 nilOL (mkVReg vu II32))
+ = return (ChildCode64 nilOL (RegVirtual $ mkVirtualReg vu II32))
iselExpr64 (CmmLit (CmmInt i _)) = do
(rlo,rhi) <- getNewRegPairNat II32
@@ -413,7 +414,7 @@ getRegister (CmmLoad mem pk)
| not (isWord64 pk)
= do
Amode addr addr_code <- getAmode mem
- let code dst = ASSERT((regClass dst == RcDouble) == isFloatType pk)
+ let code dst = ASSERT((targetClassOfReg dst == RcDouble) == isFloatType pk)
addr_code `snocOL` LD size dst addr
return (Any size code)
where size = cmmTypeSize pk
diff --git a/compiler/nativeGen/PPC/Instr.hs b/compiler/nativeGen/PPC/Instr.hs
index 58ddc21d40..d4d809825d 100644
--- a/compiler/nativeGen/PPC/Instr.hs
+++ b/compiler/nativeGen/PPC/Instr.hs
@@ -22,6 +22,7 @@ import PPC.Regs
import PPC.Cond
import Instruction
import Size
+import TargetReg
import RegClass
import Reg
@@ -353,7 +354,7 @@ ppc_mkSpillInstr
ppc_mkSpillInstr reg delta slot
= let off = spillSlotToOffset slot
in
- let sz = case regClass reg of
+ let sz = case targetClassOfReg reg of
RcInteger -> II32
RcDouble -> FF64
_ -> panic "PPC.Instr.mkSpillInstr: no match"
@@ -369,7 +370,7 @@ ppc_mkLoadInstr
ppc_mkLoadInstr reg delta slot
= let off = spillSlotToOffset slot
in
- let sz = case regClass reg of
+ let sz = case targetClassOfReg reg of
RcInteger -> II32
RcDouble -> FF64
_ -> panic "PPC.Instr.mkLoadInstr: no match"
diff --git a/compiler/nativeGen/PPC/Ppr.hs b/compiler/nativeGen/PPC/Ppr.hs
index 8378dd17d3..ec6d941191 100644
--- a/compiler/nativeGen/PPC/Ppr.hs
+++ b/compiler/nativeGen/PPC/Ppr.hs
@@ -31,6 +31,7 @@ import Instruction
import Size
import Reg
import RegClass
+import TargetReg
import BlockId
import Cmm
@@ -469,7 +470,7 @@ pprInstr (MR reg1 reg2)
| reg1 == reg2 = empty
| otherwise = hcat [
char '\t',
- case regClass reg1 of
+ case targetClassOfReg reg1 of
RcInteger -> ptext (sLit "mr")
_ -> ptext (sLit "fmr"),
char '\t',
diff --git a/compiler/nativeGen/PPC/RegInfo.hs b/compiler/nativeGen/PPC/RegInfo.hs
index 719d76c316..37de7522f6 100644
--- a/compiler/nativeGen/PPC/RegInfo.hs
+++ b/compiler/nativeGen/PPC/RegInfo.hs
@@ -7,14 +7,11 @@
-----------------------------------------------------------------------------
module PPC.RegInfo (
- mkVReg,
-
JumpDest,
canShortcut,
shortcutJump,
- shortcutStatic,
- regDotColor
+ shortcutStatic
)
where
@@ -24,28 +21,12 @@ where
import PPC.Regs
import PPC.Instr
-import RegClass
-import Reg
-import Size
import BlockId
import Cmm
import CLabel
import Outputable
-import Unique
-
-mkVReg :: Unique -> Size -> Reg
-mkVReg u size
- | not (isFloatSize size) = RegVirtual $ VirtualRegI u
- | otherwise
- = case size of
- FF32 -> RegVirtual $ VirtualRegD u
- FF64 -> RegVirtual $ VirtualRegD u
- _ -> panic "mkVReg"
-
-
-
data JumpDest = DestBlockId BlockId | DestImm Imm
@@ -84,11 +65,3 @@ shortBlockId fn blockid@(BlockId uq) =
Just (DestImm (ImmCLbl lbl)) -> lbl
_other -> panic "shortBlockId"
-
-
-regDotColor :: Reg -> SDoc
-regDotColor reg
- = case regClass reg of
- RcInteger -> text "blue"
- RcFloat -> text "red"
- RcDouble -> text "green"
diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
index c39313a6f2..467ea49786 100644
--- a/compiler/nativeGen/PPC/Regs.hs
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -5,6 +5,13 @@
-- -----------------------------------------------------------------------------
module PPC.Regs (
+ -- squeeze functions
+ virtualRegSqueeze,
+ realRegSqueeze,
+
+ mkVirtualReg,
+ regDotColor,
+
-- immediates
Imm(..),
strImmLit,
@@ -20,7 +27,7 @@ module PPC.Regs (
allArgRegs,
callClobberedRegs,
allMachRegNos,
- regClass,
+ classOfRealReg,
showReg,
-- machine specific
@@ -46,21 +53,107 @@ where
import Reg
import RegClass
+import Size
import CgUtils ( get_GlobalReg_addr )
import BlockId
import Cmm
import CLabel ( CLabel )
+import Unique
+
import Pretty
-import Outputable ( Outputable(..), pprPanic, panic )
+import Outputable ( panic, SDoc )
import qualified Outputable
import Constants
import FastBool
+import FastTypes
import Data.Word ( Word8, Word16, Word32 )
import Data.Int ( Int8, Int16, Int32 )
+-- squeese functions for the graph allocator -----------------------------------
+
+-- | regSqueeze_class reg
+-- Calculuate the maximum number of register colors that could be
+-- denied to a node of this class due to having this reg
+-- as a neighbour.
+--
+{-# INLINE virtualRegSqueeze #-}
+virtualRegSqueeze :: RegClass -> VirtualReg -> FastInt
+virtualRegSqueeze cls vr
+ = case cls of
+ RcInteger
+ -> case vr of
+ VirtualRegI{} -> _ILIT(1)
+ VirtualRegHi{} -> _ILIT(1)
+ VirtualRegD{} -> _ILIT(0)
+ VirtualRegF{} -> _ILIT(0)
+
+ -- We don't use floats on this arch, but we can't
+ -- return error because the return type is unboxed...
+ RcFloat
+ -> case vr of
+ VirtualRegI{} -> _ILIT(0)
+ VirtualRegHi{} -> _ILIT(0)
+ VirtualRegD{} -> _ILIT(0)
+ VirtualRegF{} -> _ILIT(0)
+
+ RcDouble
+ -> case vr of
+ VirtualRegI{} -> _ILIT(0)
+ VirtualRegHi{} -> _ILIT(0)
+ VirtualRegD{} -> _ILIT(1)
+ VirtualRegF{} -> _ILIT(0)
+
+
+{-# INLINE realRegSqueeze #-}
+realRegSqueeze :: RegClass -> RealReg -> FastInt
+realRegSqueeze cls rr
+ = case cls of
+ RcInteger
+ -> case rr of
+ RealRegSingle regNo
+ | regNo < 32 -> _ILIT(1) -- first fp reg is 32
+ | otherwise -> _ILIT(0)
+
+ RealRegPair{} -> _ILIT(0)
+
+ -- We don't use floats on this arch, but we can't
+ -- return error because the return type is unboxed...
+ RcFloat
+ -> case rr of
+ RealRegSingle regNo
+ | regNo < 32 -> _ILIT(0)
+ | otherwise -> _ILIT(0)
+
+ RealRegPair{} -> _ILIT(0)
+
+ RcDouble
+ -> case rr of
+ RealRegSingle regNo
+ | regNo < 32 -> _ILIT(0)
+ | otherwise -> _ILIT(1)
+
+ RealRegPair{} -> _ILIT(0)
+
+mkVirtualReg :: Unique -> Size -> VirtualReg
+mkVirtualReg u size
+ | not (isFloatSize size) = VirtualRegI u
+ | otherwise
+ = case size of
+ FF32 -> VirtualRegD u
+ FF64 -> VirtualRegD u
+ _ -> panic "mkVirtualReg"
+
+regDotColor :: RealReg -> SDoc
+regDotColor reg
+ = case classOfRealReg reg of
+ RcInteger -> Outputable.text "blue"
+ RcFloat -> Outputable.text "red"
+ RcDouble -> Outputable.text "green"
+
+
-- immediates ------------------------------------------------------------------
data Imm
= ImmInt Int
@@ -173,18 +266,13 @@ allMachRegNos :: [RegNo]
allMachRegNos = [0..63]
-{-# INLINE regClass #-}
-regClass :: Reg -> RegClass
-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))
+{-# INLINE classOfRealReg #-}
+classOfRealReg :: RealReg -> RegClass
+classOfRealReg (RealRegSingle i)
| i < 32 = RcInteger
| otherwise = RcDouble
-regClass (RegReal (RealRegPair{}))
+classOfRealReg (RealRegPair{})
= panic "regClass(ppr): no reg pairs on this architecture"
showReg :: RegNo -> String
@@ -541,7 +629,7 @@ get_GlobalReg_reg_or_addr mid
-- allocatableRegs is allMachRegNos with the fixed-use regs removed.
-- i.e., these are the regs for which we are prepared to allow the
-- register allocator to attempt to map VRegs to.
-allocatableRegs :: [RegNo]
+allocatableRegs :: [RealReg]
allocatableRegs
= let isFree i = isFastTrue (freeReg i)
- in filter isFree allMachRegNos
+ in map RealRegSingle $ filter isFree allMachRegNos
View Lorry Controller Status