compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs

   1
   2 -- | Free regs map for SPARC
   3 module RegAlloc.Linear.SPARC.FreeRegs
   4 where
   5
   6 import SPARC.Regs
   7 import SPARC.RegPlate
   8 import RegClass
   9 import Reg
  10
  11 import Outputable
  12 import FastBool
  13
  14 import Data.Word
  15 import Data.Bits
  16 import Data.List
  17
  18
  19 --------------------------------------------------------------------------------
  20 -- SPARC is like PPC, except for twinning of floating point regs.
  21 --      When we allocate a double reg we must take an even numbered
  22 --      float reg, as well as the one after it.
  23
  24
  25 -- Holds bitmaps showing what registers are currently allocated.
  26 --      The float and double reg bitmaps overlap, but we only alloc
  27 --      float regs into the float map, and double regs into the double map.
  28 --
  29 --      Free regs have a bit set in the corresponding bitmap.
  30 --
  31 data FreeRegs
  32         = FreeRegs
  33                 !Word32         -- int    reg bitmap    regs  0..31
  34                 !Word32         -- float  reg bitmap    regs 32..63
  35                 !Word32         -- double reg bitmap    regs 32..63
  36
  37 instance Show FreeRegs where
  38         show = showFreeRegs
  39
  40 -- | A reg map where no regs are free to be allocated.
  41 noFreeRegs :: FreeRegs
  42 noFreeRegs = FreeRegs 0 0 0
  43
  44
  45 -- | The initial set of free regs.
  46 initFreeRegs :: FreeRegs
  47 initFreeRegs
  48  =      foldr releaseReg noFreeRegs allocatableRegs
  49
  50
  51 -- | Get all the free registers of this class.
  52 getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazilly
  53 getFreeRegs cls (FreeRegs g f d)
  54         | RcInteger <- cls = map RealRegSingle                  $ go 1 g 1 0
  55         | RcFloat   <- cls = map RealRegSingle                  $ go 1 f 1 32
  56         | RcDouble  <- cls = map (\i -> RealRegPair i (i+1))    $ go 2 d 1 32
  57         | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class " (ppr cls)
  58         where
  59                 go _    _      0    _
  60                         = []
  61
  62                 go step bitmap mask ix
  63                         | bitmap .&. mask /= 0
  64                         = ix : (go step bitmap (mask `shiftL` step) $! ix + step)
  65
  66                         | otherwise
  67                         = go step bitmap (mask `shiftL` step) $! ix + step
  68
  69
  70 -- | Grab a register.
  71 allocateReg :: RealReg -> FreeRegs -> FreeRegs
  72 allocateReg
  73          reg@(RealRegSingle r)
  74              (FreeRegs g f d)
  75
  76         -- can't allocate free regs
  77         | not $ isFastTrue (freeReg r)
  78         = pprPanic "SPARC.FreeRegs.allocateReg: not allocating pinned reg" (ppr reg)
  79
  80         -- a general purpose reg
  81         | r <= 31
  82         = let   mask    = complement (bitMask r)
  83           in    FreeRegs
  84                         (g .&. mask)
  85                         f
  86                         d
  87
  88         -- a float reg
  89         | r >= 32, r <= 63
  90         = let   mask    = complement (bitMask (r - 32))
  91
  92                 -- the mask of the double this FP reg aliases
  93                 maskLow = if r `mod` 2 == 0
  94                                 then complement (bitMask (r - 32))
  95                                 else complement (bitMask (r - 32 - 1))
  96           in    FreeRegs
  97                         g
  98                         (f .&. mask)
  99                         (d .&. maskLow)
 100
 101         | otherwise
 102         = pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
 103
 104 allocateReg
 105          reg@(RealRegPair r1 r2)
 106              (FreeRegs g f d)
 107
 108         | r1 >= 32, r1 <= 63, r1 `mod` 2 == 0
 109         , r2 >= 32, r2 <= 63
 110         = let   mask1   = complement (bitMask (r1 - 32))
 111                 mask2   = complement (bitMask (r2 - 32))
 112           in
 113                 FreeRegs
 114                         g
 115                         ((f .&. mask1) .&. mask2)
 116                         (d .&. mask1)
 117
 118         | otherwise
 119         = pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
 120
 121
 122
 123 -- | Release a register from allocation.
 124 --      The register liveness information says that most regs die after a C call,
 125 --      but we still don't want to allocate to some of them.
 126 --
 127 releaseReg :: RealReg -> FreeRegs -> FreeRegs
 128 releaseReg
 129          reg@(RealRegSingle r)
 130         regs@(FreeRegs g f d)
 131
 132         -- don't release pinned reg
 133         | not $ isFastTrue (freeReg r)
 134         = regs
 135
 136         -- a general purpose reg
 137         | r <= 31
 138         = let   mask    = bitMask r
 139           in    FreeRegs (g .|. mask) f d
 140
 141         -- a float reg
 142         | r >= 32, r <= 63
 143         = let   mask    = bitMask (r - 32)
 144
 145                 -- the mask of the double this FP reg aliases
 146                 maskLow = if r `mod` 2 == 0
 147                                 then bitMask (r - 32)
 148                                 else bitMask (r - 32 - 1)
 149           in    FreeRegs
 150                         g
 151                         (f .|. mask)
 152                         (d .|. maskLow)
 153
 154         | otherwise
 155         = pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
 156
 157 releaseReg
 158          reg@(RealRegPair r1 r2)
 159              (FreeRegs g f d)
 160
 161         | r1 >= 32, r1 <= 63, r1 `mod` 2 == 0
 162         , r2 >= 32, r2 <= 63
 163         = let   mask1   = bitMask (r1 - 32)
 164                 mask2   = bitMask (r2 - 32)
 165           in
 166                 FreeRegs
 167                         g
 168                         ((f .|. mask1) .|. mask2)
 169                         (d .|. mask1)
 170
 171         | otherwise
 172         = pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
 173
 174
 175
 176 bitMask :: Int -> Word32
 177 bitMask n       = 1 `shiftL` n
 178
 179
 180 showFreeRegs :: FreeRegs -> String
 181 showFreeRegs regs
 182         =  "FreeRegs\n"
 183         ++ "    integer: " ++ (show $ getFreeRegs RcInteger regs)       ++ "\n"
 184         ++ "      float: " ++ (show $ getFreeRegs RcFloat   regs)       ++ "\n"
 185         ++ "     double: " ++ (show $ getFreeRegs RcDouble  regs)       ++ "\n"
 186