FreeRegs.hs 5.82 KB
Newer Older
1 2 3 4 5

-- | Free regs map for SPARC
module RegAlloc.Linear.SPARC.FreeRegs
where

6 7 8
import SPARC.Regs
import RegClass
import Reg
9

10
import CodeGen.Platform
11
import Outputable
12
import Platform
13 14 15

import Data.Word
import Data.Bits
16
-- import Data.List
17

18

19 20
--------------------------------------------------------------------------------
-- SPARC is like PPC, except for twinning of floating point regs.
benl's avatar
benl committed
21 22
--      When we allocate a double reg we must take an even numbered
--      float reg, as well as the one after it.
23 24 25


-- Holds bitmaps showing what registers are currently allocated.
benl's avatar
benl committed
26 27
--      The float and double reg bitmaps overlap, but we only alloc
--      float regs into the float map, and double regs into the double map.
28
--
benl's avatar
benl committed
29
--      Free regs have a bit set in the corresponding bitmap.
30 31
--
data FreeRegs 
benl's avatar
benl committed
32 33 34 35
        = FreeRegs 
                !Word32         -- int    reg bitmap    regs  0..31
                !Word32         -- float  reg bitmap    regs 32..63
                !Word32         -- double reg bitmap    regs 32..63
36

37
instance Show FreeRegs where
benl's avatar
benl committed
38
        show = showFreeRegs
39 40 41 42 43 44 45

-- | A reg map where no regs are free to be allocated.
noFreeRegs :: FreeRegs
noFreeRegs = FreeRegs 0 0 0


-- | The initial set of free regs.
46 47
initFreeRegs :: Platform -> FreeRegs
initFreeRegs platform
benl's avatar
benl committed
48
 =      foldr (releaseReg platform) noFreeRegs allocatableRegs
49

benl's avatar
benl committed
50
                        
51
-- | Get all the free registers of this class.
Gabor Greif's avatar
Gabor Greif committed
52
getFreeRegs :: RegClass -> FreeRegs -> [RealReg]        -- lazily
53
getFreeRegs cls (FreeRegs g f d)
benl's avatar
benl committed
54 55 56 57 58 59 60
        | RcInteger <- cls = map RealRegSingle                  $ go 1 g 1 0  
        | RcFloat   <- cls = map RealRegSingle                  $ go 1 f 1 32 
        | RcDouble  <- cls = map (\i -> RealRegPair i (i+1))    $ go 2 d 1 32 
        | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class " (ppr cls)
        where
                go _    _      0    _
                        = []
61

benl's avatar
benl committed
62 63 64
                go step bitmap mask ix 
                        | bitmap .&. mask /= 0 
                        = ix : (go step bitmap (mask `shiftL` step) $! ix + step) 
65

benl's avatar
benl committed
66 67
                        | otherwise    
                        = go step bitmap (mask `shiftL` step) $! ix + step
68 69 70


-- | Grab a register.
71 72
allocateReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
allocateReg platform
benl's avatar
benl committed
73 74 75 76
         reg@(RealRegSingle r)
             (FreeRegs g f d)

        -- can't allocate free regs
thomie's avatar
thomie committed
77
        | not $ freeReg platform r
benl's avatar
benl committed
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103
        = pprPanic "SPARC.FreeRegs.allocateReg: not allocating pinned reg" (ppr reg)
        
        -- a general purpose reg
        | r <= 31
        = let   mask    = complement (bitMask r)
          in    FreeRegs 
                        (g .&. mask) 
                        f 
                        d

        -- a float reg
        | r >= 32, r <= 63
        = let   mask    = complement (bitMask (r - 32))
        
                -- the mask of the double this FP reg aliases
                maskLow = if r `mod` 2 == 0
                                then complement (bitMask (r - 32))
                                else complement (bitMask (r - 32 - 1))
          in    FreeRegs
                        g
                        (f .&. mask)
                        (d .&. maskLow)

        | otherwise
        = pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
                        
104
allocateReg _
benl's avatar
benl committed
105
         reg@(RealRegPair r1 r2)
106
             (FreeRegs g f d)
benl's avatar
benl committed
107 108 109 110 111 112 113 114 115 116 117 118 119
        
        | r1 >= 32, r1 <= 63, r1 `mod` 2 == 0
        , r2 >= 32, r2 <= 63
        = let   mask1   = complement (bitMask (r1 - 32))
                mask2   = complement (bitMask (r2 - 32))
          in
                FreeRegs
                        g
                        ((f .&. mask1) .&. mask2)
                        (d .&. mask1)
                        
        | otherwise
        = pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
120
 
121 122 123


-- | Release a register from allocation.
benl's avatar
benl committed
124 125
--      The register liveness information says that most regs die after a C call, 
--      but we still don't want to allocate to some of them.
126
--
127 128
releaseReg :: Platform -> RealReg -> FreeRegs -> FreeRegs
releaseReg platform
benl's avatar
benl committed
129 130 131 132
         reg@(RealRegSingle r) 
        regs@(FreeRegs g f d)

        -- don't release pinned reg
thomie's avatar
thomie committed
133
        | not $ freeReg platform r
benl's avatar
benl committed
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
        = regs

        -- a general purpose reg
        | r <= 31       
        = let   mask    = bitMask r
          in    FreeRegs (g .|. mask) f d

        -- a float reg
        | r >= 32, r <= 63
        = let   mask    = bitMask (r - 32)
                
                -- the mask of the double this FP reg aliases
                maskLow = if r `mod` 2 == 0
                                then bitMask (r - 32)
                                else bitMask (r - 32 - 1)
          in    FreeRegs 
                        g 
                        (f .|. mask)
                        (d .|. maskLow)

        | otherwise
        = pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
        
157
releaseReg _
benl's avatar
benl committed
158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
         reg@(RealRegPair r1 r2) 
             (FreeRegs g f d)

        | r1 >= 32, r1 <= 63, r1 `mod` 2 == 0
        , r2 >= 32, r2 <= 63
        = let   mask1   = bitMask (r1 - 32)
                mask2   = bitMask (r2 - 32)
          in
                FreeRegs
                        g
                        ((f .|. mask1) .|. mask2)
                        (d .|. mask1)
                        
        | otherwise
        = pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
           
174 175 176


bitMask :: Int -> Word32
benl's avatar
benl committed
177
bitMask n       = 1 `shiftL` n
178 179 180 181


showFreeRegs :: FreeRegs -> String
showFreeRegs regs
benl's avatar
benl committed
182 183 184 185
        =  "FreeRegs\n"
        ++ "    integer: " ++ (show $ getFreeRegs RcInteger regs)       ++ "\n"
        ++ "      float: " ++ (show $ getFreeRegs RcFloat   regs)       ++ "\n"
        ++ "     double: " ++ (show $ getFreeRegs RcDouble  regs)       ++ "\n"
186