NCG: Split up the native code generator into arch specific modules
[ghc-hetmet.git] / compiler / nativeGen / RegAlloc / Linear / PPC / FreeRegs.hs
1
2 -- | Free regs map for PowerPC
3 module RegAlloc.Linear.PPC.FreeRegs
4 where
5
6 import PPC.Regs
7 import RegClass
8 import Reg
9
10 import Outputable
11
12 import Data.Word
13 import Data.Bits
14 import Data.List
15
16 -- The PowerPC has 32 integer and 32 floating point registers.
17 -- This is 32bit PowerPC, so Word64 is inefficient - two Word32s are much
18 -- better.
19 -- Note that when getFreeRegs scans for free registers, it starts at register
20 -- 31 and counts down. This is a hack for the PowerPC - the higher-numbered
21 -- registers are callee-saves, while the lower regs are caller-saves, so it
22 -- makes sense to start at the high end.
23 -- Apart from that, the code does nothing PowerPC-specific, so feel free to
24 -- add your favourite platform to the #if (if you have 64 registers but only
25 -- 32-bit words).
26
27 data FreeRegs = FreeRegs !Word32 !Word32
28               deriving( Show )  -- The Show is used in an ASSERT
29
30 noFreeRegs :: FreeRegs
31 noFreeRegs = FreeRegs 0 0
32
33 releaseReg :: RegNo -> FreeRegs -> FreeRegs
34 releaseReg r (FreeRegs g f)
35     | r > 31    = FreeRegs g (f .|. (1 `shiftL` (fromIntegral r - 32)))
36     | otherwise = FreeRegs (g .|. (1 `shiftL` fromIntegral r)) f
37     
38 initFreeRegs :: FreeRegs
39 initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
40
41 getFreeRegs :: RegClass -> FreeRegs -> [RegNo]  -- lazilly
42 getFreeRegs cls (FreeRegs g f)
43     | RcDouble <- cls = go f (0x80000000) 63
44     | RcInteger <- cls = go g (0x80000000) 31
45     | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class" (ppr cls)
46     where
47         go _ 0 _ = []
48         go x m i | x .&. m /= 0 = i : (go x (m `shiftR` 1) $! i-1)
49                  | otherwise    = go x (m `shiftR` 1) $! i-1
50
51 allocateReg :: RegNo -> FreeRegs -> FreeRegs
52 allocateReg r (FreeRegs g f) 
53     | r > 31    = FreeRegs g (f .&. complement (1 `shiftL` (fromIntegral r - 32)))
54     | otherwise = FreeRegs (g .&. complement (1 `shiftL` fromIntegral r)) f
55
56