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