1-- -----------------------------------------------------------------------------
2--
3-- (c) The University of Glasgow 1994-2004
4--
5-- -----------------------------------------------------------------------------
6
7module SPARC.Regs (
8        -- registers
9        showReg,
10        virtualRegSqueeze,
11        realRegSqueeze,
12        classOfRealReg,
13        allRealRegs,
14
15        -- machine specific info
16        gReg, iReg, lReg, oReg, fReg,
17        fp, sp, g0, g1, g2, o0, o1, f0, f1, f6, f8, f22, f26, f27,
18
19        -- allocatable
20        allocatableRegs,
21
22        -- args
23        argRegs,
24        allArgRegs,
25        callClobberedRegs,
26
27        --
28        mkVirtualReg,
29        regDotColor
30)
31
32where
33
34
35import GhcPrelude
36
37import GHC.Platform.SPARC
38import Reg
39import RegClass
40import Format
41
42import Unique
43import Outputable
44
45{-
46        The SPARC has 64 registers of interest; 32 integer registers and 32
47        floating point registers.  The mapping of STG registers to SPARC
48        machine registers is defined in StgRegs.h.  We are, of course,
49        prepared for any eventuality.
50
51        The whole fp-register pairing thing on sparcs is a huge nuisance.  See
52        includes/stg/MachRegs.h for a description of what's going on
53        here.
54-}
55
56
57-- | Get the standard name for the register with this number.
58showReg :: RegNo -> String
59showReg n
60        | n >= 0  && n < 8   = "%g" ++ show n
61        | n >= 8  && n < 16  = "%o" ++ show (n-8)
62        | n >= 16 && n < 24  = "%l" ++ show (n-16)
63        | n >= 24 && n < 32  = "%i" ++ show (n-24)
64        | n >= 32 && n < 64  = "%f" ++ show (n-32)
65        | otherwise          = panic "SPARC.Regs.showReg: unknown sparc register"
66
67
68-- Get the register class of a certain real reg
69classOfRealReg :: RealReg -> RegClass
70classOfRealReg reg
71 = case reg of
72        RealRegSingle i
73                | i < 32        -> RcInteger
74                | otherwise     -> RcFloat
75
76        RealRegPair{}           -> RcDouble
77
78
79-- | regSqueeze_class reg
80--      Calculate the maximum number of register colors that could be
81--      denied to a node of this class due to having this reg
82--      as a neighbour.
83--
84{-# INLINE virtualRegSqueeze #-}
85virtualRegSqueeze :: RegClass -> VirtualReg -> Int
86
87virtualRegSqueeze cls vr
88 = case cls of
89        RcInteger
90         -> case vr of
91                VirtualRegI{}           -> 1
92                VirtualRegHi{}          -> 1
93                _other                  -> 0
94
95        RcFloat
96         -> case vr of
97                VirtualRegF{}           -> 1
98                VirtualRegD{}           -> 2
99                _other                  -> 0
100
101        RcDouble
102         -> case vr of
103                VirtualRegF{}           -> 1
104                VirtualRegD{}           -> 1
105                _other                  -> 0
106
107
108{-# INLINE realRegSqueeze #-}
109realRegSqueeze :: RegClass -> RealReg -> Int
110
111realRegSqueeze cls rr
112 = case cls of
113        RcInteger
114         -> case rr of
115                RealRegSingle regNo
116                        | regNo < 32    -> 1
117                        | otherwise     -> 0
118
119                RealRegPair{}           -> 0
120
121        RcFloat
122         -> case rr of
123                RealRegSingle regNo
124                        | regNo < 32    -> 0
125                        | otherwise     -> 1
126
127                RealRegPair{}           -> 2
128
129        RcDouble
130         -> case rr of
131                RealRegSingle regNo
132                        | regNo < 32    -> 0
133                        | otherwise     -> 1
134
135                RealRegPair{}           -> 1
136
137
138-- | All the allocatable registers in the machine,
139--      including register pairs.
140allRealRegs :: [RealReg]
141allRealRegs
142        =  [ (RealRegSingle i)          | i <- [0..63] ]
143        ++ [ (RealRegPair   i (i+1))    | i <- [32, 34 .. 62 ] ]
144
145
146-- | Get the regno for this sort of reg
147gReg, lReg, iReg, oReg, fReg :: Int -> RegNo
148
149gReg x  = x             -- global regs
150oReg x  = (8 + x)       -- output regs
151lReg x  = (16 + x)      -- local regs
152iReg x  = (24 + x)      -- input regs
153fReg x  = (32 + x)      -- float regs
154
155
156-- | Some specific regs used by the code generator.
157g0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg
158
159f6  = RegReal (RealRegSingle (fReg 6))
160f8  = RegReal (RealRegSingle (fReg 8))
161f22 = RegReal (RealRegSingle (fReg 22))
162f26 = RegReal (RealRegSingle (fReg 26))
163f27 = RegReal (RealRegSingle (fReg 27))
164
165-- g0 is always zero, and writes to it vanish.
166g0  = RegReal (RealRegSingle (gReg 0))
167g1  = RegReal (RealRegSingle (gReg 1))
168g2  = RegReal (RealRegSingle (gReg 2))
169
170-- FP, SP, int and float return (from C) regs.
171fp  = RegReal (RealRegSingle (iReg 6))
172sp  = RegReal (RealRegSingle (oReg 6))
173o0  = RegReal (RealRegSingle (oReg 0))
174o1  = RegReal (RealRegSingle (oReg 1))
175f0  = RegReal (RealRegSingle (fReg 0))
176f1  = RegReal (RealRegSingle (fReg 1))
177
178-- | Produce the second-half-of-a-double register given the first half.
179{-
180fPair :: Reg -> Maybe Reg
181fPair (RealReg n)
182        | n >= 32 && n `mod` 2 == 0  = Just (RealReg (n+1))
183
184fPair (VirtualRegD u)
185        = Just (VirtualRegHi u)
186
187fPair reg
188        = trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ showPpr reg)
189                Nothing
190-}
191
192
193-- | All the regs that the register allocator can allocate to,
194--      with the fixed use regs removed.
195--
196allocatableRegs :: [RealReg]
197allocatableRegs
198   = let isFree rr
199           = case rr of
200                RealRegSingle r     -> freeReg r
201                RealRegPair   r1 r2 -> freeReg r1 && freeReg r2
202     in filter isFree allRealRegs
203
204
205-- | The registers to place arguments for function calls,
206--      for some number of arguments.
207--
208argRegs :: RegNo -> [Reg]
209argRegs r
210 = case r of
211        0       -> []
212        1       -> map (RegReal . RealRegSingle . oReg) [0]
213        2       -> map (RegReal . RealRegSingle . oReg) [0,1]
214        3       -> map (RegReal . RealRegSingle . oReg) [0,1,2]
215        4       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3]
216        5       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4]
217        6       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4,5]
218        _       -> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
219
220
221-- | All all the regs that could possibly be returned by argRegs
222--
223allArgRegs :: [Reg]
224allArgRegs
225        = map (RegReal . RealRegSingle) [oReg i | i <- [0..5]]
226
227
228-- These are the regs that we cannot assume stay alive over a C call.
229--      TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
230--
231callClobberedRegs :: [Reg]
232callClobberedRegs
233        = map (RegReal . RealRegSingle)
234                (  oReg 7 :
235                  [oReg i | i <- [0..5]] ++
236                  [gReg i | i <- [1..7]] ++
237                  [fReg i | i <- [0..31]] )
238
239
240
241-- | Make a virtual reg with this format.
242mkVirtualReg :: Unique -> Format -> VirtualReg
243mkVirtualReg u format
244        | not (isFloatFormat format)
245        = VirtualRegI u
246
247        | otherwise
248        = case format of
249                FF32    -> VirtualRegF u
250                FF64    -> VirtualRegD u
251                _       -> panic "mkVReg"
252
253
254regDotColor :: RealReg -> SDoc
255regDotColor reg
256 = case classOfRealReg reg of
257        RcInteger       -> text "blue"
258        RcFloat         -> text "red"
259        _other          -> text "green"
260