ac16d8a640dca171188216ba4462c47110b71f1b
[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 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         deriving( Show )
37
38
39 -- | A reg map where no regs are free to be allocated.
40 noFreeRegs :: FreeRegs
41 noFreeRegs = FreeRegs 0 0 0
42
43
44 -- | The initial set of free regs.
45 --      Don't treat the top half of reg pairs we're using as doubles as being free.
46 initFreeRegs :: FreeRegs
47 initFreeRegs 
48  =      regs
49  where  
50 --      freeDouble      = getFreeRegs RcDouble regs
51         regs            = foldr releaseReg noFreeRegs allocable
52         allocable       = allocatableRegs \\ doublePairs
53         doublePairs     = [43, 45, 47, 49, 51, 53]
54
55                         
56 -- | Get all the free registers of this class.
57 getFreeRegs :: RegClass -> FreeRegs -> [RegNo]  -- lazilly
58 getFreeRegs cls (FreeRegs g f d)
59         | RcInteger <- cls = go g 1 0
60         | RcFloat   <- cls = go f 1 32
61         | RcDouble  <- cls = go d 1 32
62         | otherwise = pprPanic "RegAllocLinear.getFreeRegs: Bad register class " (ppr cls)
63         where
64                 go _ 0 _ = []
65                 go x m i | x .&. m /= 0 = i : (go x (m `shiftL` 1) $! i+1)
66                          | otherwise    = go x (m `shiftL` 1) $! i+1
67 {-
68 showFreeRegs :: FreeRegs -> String
69 showFreeRegs regs
70         =  "FreeRegs\n"
71         ++ "    integer: " ++ (show $ getFreeRegs RcInteger regs)       ++ "\n"
72         ++ "      float: " ++ (show $ getFreeRegs RcFloat   regs)       ++ "\n"
73         ++ "     double: " ++ (show $ getFreeRegs RcDouble  regs)       ++ "\n"
74 -}
75
76 {-
77 -- | Check whether a reg is free
78 regIsFree :: RegNo -> FreeRegs -> Bool
79 regIsFree r (FreeRegs g f d)
80
81         -- a general purpose reg
82         | r <= 31       
83         , mask  <- 1 `shiftL` fromIntegral r
84         = g .&. mask /= 0
85
86         -- use the first 22 float regs as double precision
87         | r >= 32
88         , r <= 53
89         , mask  <- 1 `shiftL` (fromIntegral r - 32)
90         = d .&. mask /= 0
91
92         -- use the last 10 float regs as single precision
93         | otherwise 
94         , mask  <- 1 `shiftL` (fromIntegral r - 32)
95         = f .&. mask /= 0
96 -}
97
98 -- | Grab a register.
99 grabReg :: RegNo -> FreeRegs -> FreeRegs
100 grabReg r (FreeRegs g f d)
101
102         -- a general purpose reg
103         | r <= 31
104         , mask  <- complement (1 `shiftL` fromIntegral r)
105         = FreeRegs (g .&. mask) f d
106     
107         -- use the first 22 float regs as double precision
108         | r >= 32
109         , r <= 53
110         , mask  <- complement (1 `shiftL` (fromIntegral r - 32))
111         = FreeRegs g f (d .&. mask)
112
113         -- use the last 10 float regs as single precision
114         | otherwise
115         , mask  <- complement (1 `shiftL` (fromIntegral r - 32))
116         = FreeRegs g (f .&. mask) d
117
118
119
120 -- | Release a register from allocation.
121 --      The register liveness information says that most regs die after a C call, 
122 --      but we still don't want to allocate to some of them.
123 --
124 releaseReg :: RegNo -> FreeRegs -> FreeRegs
125 releaseReg r regs@(FreeRegs g f d)
126         -- don't release pinned reg
127         | not $ isFastTrue (freeReg r)
128         = regs
129         
130         -- don't release the high part of double regs
131         --      this prevents them from being allocated as single precison regs.
132         | r == 39       = regs
133         | r == 41       = regs
134         | r == 43       = regs
135         | r == 45       = regs
136         | r == 47       = regs
137         | r == 49       = regs
138         | r == 51       = regs
139         | r == 53       = regs
140         
141         -- a general purpose reg
142         | r <= 31       
143         , mask  <- 1 `shiftL` fromIntegral r
144         = FreeRegs (g .|. mask) f d
145
146         -- use the first 22 float regs as double precision
147         | r >= 32
148         , r <= 53
149         , mask  <- 1 `shiftL` (fromIntegral r - 32)
150         = FreeRegs g f (d .|. mask)
151
152         -- use the last 10 float regs as single precision
153         | otherwise 
154         , mask  <- 1 `shiftL` (fromIntegral r - 32)
155         = FreeRegs g (f .|. mask) d
156
157
158 -- | Allocate a register in the map.
159 allocateReg :: RegNo -> FreeRegs -> FreeRegs
160 allocateReg r regs -- (FreeRegs g f d) 
161
162         -- if the reg isn't actually free then we're in trouble
163 {-      | not $ regIsFree r regs
164         = pprPanic 
165                 "RegAllocLinear.allocateReg"
166                 (text "reg " <> ppr r <> text " is not free")
167 -}  
168         | otherwise
169         = grabReg r regs
170