PPC.hs 2.1 KB
Newer Older
1
-- | Free regs map for PowerPC
Sylvain Henry's avatar
Sylvain Henry committed
2
module GHC.CmmToAsm.Reg.Linear.PPC where
3

4 5
import GhcPrelude

Sylvain Henry's avatar
Sylvain Henry committed
6 7 8
import GHC.CmmToAsm.PPC.Regs
import GHC.Platform.Reg.Class
import GHC.Platform.Reg
9 10

import Outputable
John Ericson's avatar
John Ericson committed
11
import GHC.Platform
12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27

import Data.Word
import Data.Bits

-- The PowerPC has 32 integer and 32 floating point registers.
-- This is 32bit PowerPC, so Word64 is inefficient - two Word32s are much
-- better.
-- Note that when getFreeRegs scans for free registers, it starts at register
-- 31 and counts down. This is a hack for the PowerPC - the higher-numbered
-- registers are callee-saves, while the lower regs are caller-saves, so it
-- makes sense to start at the high end.
-- Apart from that, the code does nothing PowerPC-specific, so feel free to
-- add your favourite platform to the #if (if you have 64 registers but only
-- 32-bit words).

data FreeRegs = FreeRegs !Word32 !Word32
benl's avatar
benl committed
28
              deriving( Show )  -- The Show is used in an ASSERT
29 30 31 32

noFreeRegs :: FreeRegs
noFreeRegs = FreeRegs 0 0

33 34
releaseReg :: RealReg -> FreeRegs -> FreeRegs
releaseReg (RealRegSingle r) (FreeRegs g f)
35 36
    | r > 31    = FreeRegs g (f .|. (1 `shiftL` (r - 32)))
    | otherwise = FreeRegs (g .|. (1 `shiftL` r)) f
37 38

releaseReg _ _
benl's avatar
benl committed
39
        = panic "RegAlloc.Linear.PPC.releaseReg: bad reg"
40

41
initFreeRegs :: Platform -> FreeRegs
42
initFreeRegs platform = foldl' (flip releaseReg) noFreeRegs (allocatableRegs platform)
43

Gabor Greif's avatar
Gabor Greif committed
44
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazily
45 46 47 48 49 50
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 _ = []
51
        go x m i | x .&. m /= 0 = RealRegSingle i : (go x (m `shiftR` 1) $! i-1)
52 53
                 | otherwise    = go x (m `shiftR` 1) $! i-1

54
allocateReg :: RealReg -> FreeRegs -> FreeRegs
55
allocateReg (RealRegSingle r) (FreeRegs g f)
56 57
    | r > 31    = FreeRegs g (f .&. complement (1 `shiftL` (r - 32)))
    | otherwise = FreeRegs (g .&. complement (1 `shiftL` r)) f
58

59
allocateReg _ _
benl's avatar
benl committed
60
        = panic "RegAlloc.Linear.PPC.allocateReg: bad reg"