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 :: RealReg -> FreeRegs -> FreeRegs
  34 releaseReg (RealRegSingle 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 releaseReg _ _
  39         = panic "RegAlloc.Linear.PPC.releaseReg: bad reg"
  40
  41 initFreeRegs :: FreeRegs
  42 initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
  43
  44 getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazilly
  45 getFreeRegs cls (FreeRegs g f)
  46     | RcDouble <- cls = go f (0x80000000) 63
  47     | RcInteger <- cls = go g (0x80000000) 31
  48     | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class" (ppr cls)
  49     where
  50         go _ 0 _ = []
  51         go x m i | x .&. m /= 0 = RealRegSingle i : (go x (m `shiftR` 1) $! i-1)
  52                  | otherwise    = go x (m `shiftR` 1) $! i-1
  53
  54 allocateReg :: RealReg -> FreeRegs -> FreeRegs
  55 allocateReg (RealRegSingle r) (FreeRegs g f)
  56     | r > 31    = FreeRegs g (f .&. complement (1 `shiftL` (fromIntegral r - 32)))
  57     | otherwise = FreeRegs (g .&. complement (1 `shiftL` fromIntegral r)) f
  58
  59 allocateReg _ _
  60         = panic "RegAlloc.Linear.PPC.allocateReg: bad reg"