d284a45dc8718ffcd3bef4d3039a179cca3f507e
[ghc-hetmet.git] / 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 MachRegs
7
8 import Outputable
9
10 import Data.Word
11 import Data.Bits
12 import Data.List
13
14 --------------------------------------------------------------------------------
15 -- SPARC is like PPC, except for twinning of floating point regs.
16 --      When we allocate a double reg we must take an even numbered
17 --      float reg, as well as the one after it.
18
19
20 -- Holds bitmaps showing what registers are currently allocated.
21 --      The float and double reg bitmaps overlap, but we only alloc
22 --      float regs into the float map, and double regs into the double map.
23 --
24 --      Free regs have a bit set in the corresponding bitmap.
25 --
26 data FreeRegs 
27         = FreeRegs 
28                 !Word32         -- int    reg bitmap    regs  0..31
29                 !Word32         -- float  reg bitmap    regs 32..63
30                 !Word32         -- double reg bitmap    regs 32..63
31         deriving( Show )
32
33
34 -- | A reg map where no regs are free to be allocated.
35 noFreeRegs :: FreeRegs
36 noFreeRegs = FreeRegs 0 0 0
37
38
39 -- | The initial set of free regs.
40 --      Don't treat the top half of reg pairs we're using as doubles as being free.
41 initFreeRegs :: FreeRegs
42 initFreeRegs 
43  =      regs
44  where  
45 --      freeDouble      = getFreeRegs RcDouble regs
46         regs            = foldr releaseReg noFreeRegs allocable
47         allocable       = allocatableRegs \\ doublePairs
48         doublePairs     = [43, 45, 47, 49, 51, 53]
49
50                         
51 -- | Get all the free registers of this class.
52 getFreeRegs :: RegClass -> FreeRegs -> [RegNo]  -- lazilly
53 getFreeRegs cls (FreeRegs g f d)
54         | RcInteger <- cls = go g 1 0
55         | RcFloat   <- cls = go f 1 32
56         | RcDouble  <- cls = go d 1 32
57         | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class " (ppr cls)
58         where
59                 go _ 0 _ = []
60                 go x m i | x .&. m /= 0 = i : (go x (m `shiftL` 1) $! i+1)
61                          | otherwise    = go x (m `shiftL` 1) $! i+1
62 {-
63 showFreeRegs :: FreeRegs -> String
64 showFreeRegs regs
65         =  "FreeRegs\n"
66         ++ "    integer: " ++ (show $ getFreeRegs RcInteger regs)       ++ "\n"
67         ++ "      float: " ++ (show $ getFreeRegs RcFloat   regs)       ++ "\n"
68         ++ "     double: " ++ (show $ getFreeRegs RcDouble  regs)       ++ "\n"
69 -}
70
71 {-
72 -- | Check whether a reg is free
73 regIsFree :: RegNo -> FreeRegs -> Bool
74 regIsFree r (FreeRegs g f d)
75
76         -- a general purpose reg
77         | r <= 31       
78         , mask  <- 1 `shiftL` fromIntegral r
79         = g .&. mask /= 0
80
81         -- use the first 22 float regs as double precision
82         | r >= 32
83         , r <= 53
84         , mask  <- 1 `shiftL` (fromIntegral r - 32)
85         = d .&. mask /= 0
86
87         -- use the last 10 float regs as single precision
88         | otherwise 
89         , mask  <- 1 `shiftL` (fromIntegral r - 32)
90         = f .&. mask /= 0
91 -}
92
93 -- | Grab a register.
94 grabReg :: RegNo -> FreeRegs -> FreeRegs
95 grabReg r (FreeRegs g f d)
96
97         -- a general purpose reg
98         | r <= 31
99         , mask  <- complement (1 `shiftL` fromIntegral r)
100         = FreeRegs (g .&. mask) f d
101     
102         -- use the first 22 float regs as double precision
103         | r >= 32
104         , r <= 53
105         , mask  <- complement (1 `shiftL` (fromIntegral r - 32))
106         = FreeRegs g f (d .&. mask)
107
108         -- use the last 10 float regs as single precision
109         | otherwise
110         , mask  <- complement (1 `shiftL` (fromIntegral r - 32))
111         = FreeRegs g (f .&. mask) d
112
113
114
115 -- | Release a register from allocation.
116 --      The register liveness information says that most regs die after a C call, 
117 --      but we still don't want to allocate to some of them.
118 --
119 releaseReg :: RegNo -> FreeRegs -> FreeRegs
120 releaseReg r regs@(FreeRegs g f d)
121
122         -- used by STG machine, or otherwise unavailable
123         | r >= 0  && r <= 15    = regs
124 --      | r >= 3  && r <= 15    = regs
125
126         | r >= 17 && r <= 21    = regs
127         | r >= 24 && r <= 31    = regs
128         | r >= 32 && r <= 41    = regs
129         | r >= 54 && r <= 59    = regs
130
131         -- never release the high part of double regs.
132         | r == 43               = regs
133         | r == 45               = regs
134         | r == 47               = regs
135         | r == 49               = regs
136         | r == 51               = regs
137         | r == 53               = regs
138         
139         -- a general purpose reg
140         | r <= 31       
141         , mask  <- 1 `shiftL` fromIntegral r
142         = FreeRegs (g .|. mask) f d
143
144         -- use the first 22 float regs as double precision
145         | r >= 32
146         , r <= 53
147         , mask  <- 1 `shiftL` (fromIntegral r - 32)
148         = FreeRegs g f (d .|. mask)
149
150         -- use the last 10 float regs as single precision
151         | otherwise 
152         , mask  <- 1 `shiftL` (fromIntegral r - 32)
153         = FreeRegs g (f .|. mask) d
154
155
156 -- | Allocate a register in the map.
157 allocateReg :: RegNo -> FreeRegs -> FreeRegs
158 allocateReg r regs -- (FreeRegs g f d) 
159
160         -- if the reg isn't actually free then we're in trouble
161 {-      | not $ regIsFree r regs
162         = pprPanic 
163                 "RegAllocLinear.allocateReg"
164                 (text "reg " <> ppr r <> text " is not free")
165 -}  
166         | otherwise
167         = grabReg r regs
168