Skip to content

GitLab

Commit 2d498de3 authored by Ben.Lippmeier@anu.edu.au's avatar Ben.Lippmeier@anu.edu.au
Browse files

Follow vreg/hreg patch in PPC NCG

parent 9d9eef1f
Hide whitespace changes
Inline Side-by-side
compiler/nativeGen/PPC/CodeGen.hs
View file @ 2d498de3
......@@ -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
......
compiler/nativeGen/PPC/Instr.hs
View file @ 2d498de3
......@@ -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"
......
compiler/nativeGen/PPC/Ppr.hs
View file @ 2d498de3
......@@ -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',
......
compiler/nativeGen/PPC/RegInfo.hs
View file @ 2d498de3
......@@ -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"
compiler/nativeGen/PPC/Regs.hs
View file @ 2d498de3
......@@ -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
compiler/nativeGen/RegAlloc/Linear/PPC/FreeRegs.hs
View file @ 2d498de3
......@@ -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"
compiler/nativeGen/TargetReg.hs
View file @ 2d498de3
......@@ -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
......
compiler/nativeGen/X86/RegInfo.hs
View file @ 2d498de3
......@@ -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
......
compiler/nativeGen/X86/Regs.hs
View file @ 2d498de3
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment