2 -- | Free regs map for SPARC
3 module RegAlloc.Linear.SPARC.FreeRegs
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.
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.
29 -- Free regs have a bit set in the corresponding bitmap.
33 !Word32 -- int reg bitmap regs 0..31
34 !Word32 -- float reg bitmap regs 32..63
35 !Word32 -- double reg bitmap regs 32..63
37 instance Show FreeRegs where
40 -- | A reg map where no regs are free to be allocated.
41 noFreeRegs :: FreeRegs
42 noFreeRegs = FreeRegs 0 0 0
45 -- | The initial set of free regs.
46 initFreeRegs :: FreeRegs
48 = foldr releaseReg noFreeRegs allocatableRegs
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)
62 go step bitmap mask ix
63 | bitmap .&. mask /= 0
64 = ix : (go step bitmap (mask `shiftL` step) $! ix + step)
67 = go step bitmap (mask `shiftL` step) $! ix + step
71 allocateReg :: RealReg -> FreeRegs -> FreeRegs
76 -- can't allocate free regs
77 | not $ isFastTrue (freeReg r)
78 = pprPanic "SPARC.FreeRegs.allocateReg: not allocating pinned reg" (ppr reg)
80 -- a general purpose reg
82 = let mask = complement (bitMask r)
90 = let mask = complement (bitMask (r - 32))
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))
102 = pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
105 reg@(RealRegPair r1 r2)
108 | r1 >= 32, r1 <= 63, r1 `mod` 2 == 0
110 = let mask1 = complement (bitMask (r1 - 32))
111 mask2 = complement (bitMask (r2 - 32))
115 ((f .&. mask1) .&. mask2)
119 = pprPanic "SPARC.FreeRegs.releaseReg: not allocating bad reg" (ppr reg)
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.
127 releaseReg :: RealReg -> FreeRegs -> FreeRegs
129 reg@(RealRegSingle r)
130 regs@(FreeRegs g f d)
132 -- don't release pinned reg
133 | not $ isFastTrue (freeReg r)
136 -- a general purpose reg
138 = let mask = bitMask r
139 in FreeRegs (g .|. mask) f d
143 = let mask = bitMask (r - 32)
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)
155 = pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
158 reg@(RealRegPair r1 r2)
161 | r1 >= 32, r1 <= 63, r1 `mod` 2 == 0
163 = let mask1 = bitMask (r1 - 32)
164 mask2 = bitMask (r2 - 32)
168 ((f .|. mask1) .|. mask2)
172 = pprPanic "SPARC.FreeRegs.releaseReg: not releasing bad reg" (ppr reg)
176 bitMask :: Int -> Word32
177 bitMask n = 1 `shiftL` n
180 showFreeRegs :: FreeRegs -> String
183 ++ " integer: " ++ (show $ getFreeRegs RcInteger regs) ++ "\n"
184 ++ " float: " ++ (show $ getFreeRegs RcFloat regs) ++ "\n"
185 ++ " double: " ++ (show $ getFreeRegs RcDouble regs) ++ "\n"