From 2d498de3fd7a8f60621c601e419fe7cb14788b1c Mon Sep 17 00:00:00 2001 From: "Ben.Lippmeier@anu.edu.au" Date: Tue, 26 May 2009 10:55:22 +0000 Subject: [PATCH] Follow vreg/hreg patch in PPC NCG --- compiler/nativeGen/PPC/CodeGen.hs | 11 +- compiler/nativeGen/PPC/Instr.hs | 5 +- compiler/nativeGen/PPC/Ppr.hs | 3 +- compiler/nativeGen/PPC/RegInfo.hs | 29 +---- compiler/nativeGen/PPC/Regs.hs | 114 +++++++++++++++++--- compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs | 18 ++-- compiler/nativeGen/TargetReg.hs | 1 - compiler/nativeGen/X86/RegInfo.hs | 2 +- compiler/nativeGen/X86/Regs.hs | 6 +- 9 files changed, 127 insertions(+), 62 deletions(-) diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index d3ec27f..8eb515e 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 58ddc21..d4d8098 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 8378dd1..ec6d941 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 719d76c..37de752 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 c39313a..467ea49 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 diff --git a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs index 878bfe3..4310c5e 100644 --- a/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs +++ b/compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs @@ -30,27 +30,31 @@ data FreeRegs = FreeRegs !Word32 !Word32 noFreeRegs :: FreeRegs noFreeRegs = FreeRegs 0 0 -releaseReg :: RegNo -> FreeRegs -> FreeRegs -releaseReg r (FreeRegs g f) +releaseReg :: RealReg -> FreeRegs -> FreeRegs +releaseReg (RealRegSingle r) (FreeRegs g f) | r > 31 = FreeRegs g (f .|. (1 `shiftL` (fromIntegral r - 32))) | otherwise = FreeRegs (g .|. (1 `shiftL` fromIntegral r)) f + +releaseReg _ _ + = panic "RegAlloc.Linear.PPC.releaseReg: bad reg" initFreeRegs :: FreeRegs initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs -getFreeRegs :: RegClass -> FreeRegs -> [RegNo] -- lazilly +getFreeRegs :: RegClass -> FreeRegs -> [RealReg] -- lazilly getFreeRegs cls (FreeRegs g f) | RcDouble <- cls = go f (0x80000000) 63 | RcInteger <- cls = go g (0x80000000) 31 | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class" (ppr cls) where go _ 0 _ = [] - go x m i | x .&. m /= 0 = i : (go x (m `shiftR` 1) $! i-1) + go x m i | x .&. m /= 0 = RealRegSingle i : (go x (m `shiftR` 1) $! i-1) | otherwise = go x (m `shiftR` 1) $! i-1 -allocateReg :: RegNo -> FreeRegs -> FreeRegs -allocateReg r (FreeRegs g f) +allocateReg :: RealReg -> FreeRegs -> FreeRegs +allocateReg (RealRegSingle r) (FreeRegs g f) | r > 31 = FreeRegs g (f .&. complement (1 `shiftL` (fromIntegral r - 32))) | otherwise = FreeRegs (g .&. complement (1 `shiftL` fromIntegral r)) f - +allocateReg _ _ + = panic "RegAlloc.Linear.PPC.allocateReg: bad reg" diff --git a/compiler/nativeGen/TargetReg.hs b/compiler/nativeGen/TargetReg.hs index f2ed632..1a8d883 100644 --- a/compiler/nativeGen/TargetReg.hs +++ b/compiler/nativeGen/TargetReg.hs @@ -39,7 +39,6 @@ import qualified X86.RegInfo as X86 #elif powerpc_TARGET_ARCH import qualified PPC.Regs as PPC -import qualified PPC.RegInfo as PPC #elif sparc_TARGET_ARCH import qualified SPARC.Regs as SPARC diff --git a/compiler/nativeGen/X86/RegInfo.hs b/compiler/nativeGen/X86/RegInfo.hs index f47859e..3c84641 100644 --- a/compiler/nativeGen/X86/RegInfo.hs +++ b/compiler/nativeGen/X86/RegInfo.hs @@ -9,7 +9,6 @@ where #include "nativeGen/NCG.h" #include "HsVersions.h" -import X86.Regs import Size import Reg @@ -18,6 +17,7 @@ import Unique #if i386_TARGET_ARCH || x86_64_TARGET_ARCH import UniqFM +import X86.Regs #endif diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs index 840736f..9f62c25 100644 --- a/compiler/nativeGen/X86/Regs.hs +++ b/compiler/nativeGen/X86/Regs.hs @@ -108,12 +108,10 @@ virtualRegSqueeze cls vr VirtualRegD{} -> _ILIT(1) VirtualRegF{} -> _ILIT(0) - +realRegSqueeze :: RegClass -> RealReg -> FastInt #if defined(i386_TARGET_ARCH) {-# INLINE realRegSqueeze #-} -realRegSqueeze :: RegClass -> RealReg -> FastInt - realRegSqueeze cls rr = case cls of RcInteger @@ -172,7 +170,7 @@ realRegSqueeze cls rr RealRegPair{} -> _ILIT(0) #else -realRegSqueeze = _ILIT(0) +realRegSqueeze _ _ = _ILIT(0) #endif -- 1.7.10.4