summaryrefslogtreecommitdiff
path: root/compiler/GHC/CmmToAsm/SPARC/Regs.hs
blob: d6d5d87bf6f23d2a75fc8364a9f9991ae2ddda5a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
-- -----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 1994-2004
--
-- -----------------------------------------------------------------------------

module GHC.CmmToAsm.SPARC.Regs (
        -- registers
        showReg,
        virtualRegSqueeze,
        realRegSqueeze,
        classOfRealReg,
        allRealRegs,

        -- machine specific info
        gReg, iReg, lReg, oReg, fReg,
        fp, sp, g0, g1, g2, o0, o1, f0, f1, f6, f8, f22, f26, f27,

        -- allocatable
        allocatableRegs,

        -- args
        argRegs,
        allArgRegs,
        callClobberedRegs,

        --
        mkVirtualReg,
        regDotColor
)

where


import GhcPrelude

import GHC.Platform.SPARC
import GHC.Platform.Reg
import GHC.Platform.Reg.Class
import GHC.CmmToAsm.Format

import GHC.Types.Unique
import Outputable

{-
        The SPARC has 64 registers of interest; 32 integer registers and 32
        floating point registers.  The mapping of STG registers to SPARC
        machine registers is defined in StgRegs.h.  We are, of course,
        prepared for any eventuality.

        The whole fp-register pairing thing on sparcs is a huge nuisance.  See
        includes/stg/MachRegs.h for a description of what's going on
        here.
-}


-- | Get the standard name for the register with this number.
showReg :: RegNo -> String
showReg n
        | n >= 0  && n < 8   = "%g" ++ show n
        | n >= 8  && n < 16  = "%o" ++ show (n-8)
        | n >= 16 && n < 24  = "%l" ++ show (n-16)
        | n >= 24 && n < 32  = "%i" ++ show (n-24)
        | n >= 32 && n < 64  = "%f" ++ show (n-32)
        | otherwise          = panic "SPARC.Regs.showReg: unknown sparc register"


-- Get the register class of a certain real reg
classOfRealReg :: RealReg -> RegClass
classOfRealReg reg
 = case reg of
        RealRegSingle i
                | i < 32        -> RcInteger
                | otherwise     -> RcFloat

        RealRegPair{}           -> RcDouble


-- | regSqueeze_class reg
--      Calculate the maximum number of register colors that could be
--      denied to a node of this class due to having this reg
--      as a neighbour.
--
{-# INLINE virtualRegSqueeze #-}
virtualRegSqueeze :: RegClass -> VirtualReg -> Int

virtualRegSqueeze cls vr
 = case cls of
        RcInteger
         -> case vr of
                VirtualRegI{}           -> 1
                VirtualRegHi{}          -> 1
                _other                  -> 0

        RcFloat
         -> case vr of
                VirtualRegF{}           -> 1
                VirtualRegD{}           -> 2
                _other                  -> 0

        RcDouble
         -> case vr of
                VirtualRegF{}           -> 1
                VirtualRegD{}           -> 1
                _other                  -> 0


{-# INLINE realRegSqueeze #-}
realRegSqueeze :: RegClass -> RealReg -> Int

realRegSqueeze cls rr
 = case cls of
        RcInteger
         -> case rr of
                RealRegSingle regNo
                        | regNo < 32    -> 1
                        | otherwise     -> 0

                RealRegPair{}           -> 0

        RcFloat
         -> case rr of
                RealRegSingle regNo
                        | regNo < 32    -> 0
                        | otherwise     -> 1

                RealRegPair{}           -> 2

        RcDouble
         -> case rr of
                RealRegSingle regNo
                        | regNo < 32    -> 0
                        | otherwise     -> 1

                RealRegPair{}           -> 1


-- | All the allocatable registers in the machine,
--      including register pairs.
allRealRegs :: [RealReg]
allRealRegs
        =  [ (RealRegSingle i)          | i <- [0..63] ]
        ++ [ (RealRegPair   i (i+1))    | i <- [32, 34 .. 62 ] ]


-- | Get the regno for this sort of reg
gReg, lReg, iReg, oReg, fReg :: Int -> RegNo

gReg x  = x             -- global regs
oReg x  = (8 + x)       -- output regs
lReg x  = (16 + x)      -- local regs
iReg x  = (24 + x)      -- input regs
fReg x  = (32 + x)      -- float regs


-- | Some specific regs used by the code generator.
g0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg

f6  = RegReal (RealRegSingle (fReg 6))
f8  = RegReal (RealRegSingle (fReg 8))
f22 = RegReal (RealRegSingle (fReg 22))
f26 = RegReal (RealRegSingle (fReg 26))
f27 = RegReal (RealRegSingle (fReg 27))

-- g0 is always zero, and writes to it vanish.
g0  = RegReal (RealRegSingle (gReg 0))
g1  = RegReal (RealRegSingle (gReg 1))
g2  = RegReal (RealRegSingle (gReg 2))

-- FP, SP, int and float return (from C) regs.
fp  = RegReal (RealRegSingle (iReg 6))
sp  = RegReal (RealRegSingle (oReg 6))
o0  = RegReal (RealRegSingle (oReg 0))
o1  = RegReal (RealRegSingle (oReg 1))
f0  = RegReal (RealRegSingle (fReg 0))
f1  = RegReal (RealRegSingle (fReg 1))

-- | Produce the second-half-of-a-double register given the first half.
{-
fPair :: Reg -> Maybe Reg
fPair (RealReg n)
        | n >= 32 && n `mod` 2 == 0  = Just (RealReg (n+1))

fPair (VirtualRegD u)
        = Just (VirtualRegHi u)

fPair reg
        = trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ showPpr reg)
                Nothing
-}


-- | All the regs that the register allocator can allocate to,
--      with the fixed use regs removed.
--
allocatableRegs :: [RealReg]
allocatableRegs
   = let isFree rr
           = case rr of
                RealRegSingle r     -> freeReg r
                RealRegPair   r1 r2 -> freeReg r1 && freeReg r2
     in filter isFree allRealRegs


-- | The registers to place arguments for function calls,
--      for some number of arguments.
--
argRegs :: RegNo -> [Reg]
argRegs r
 = case r of
        0       -> []
        1       -> map (RegReal . RealRegSingle . oReg) [0]
        2       -> map (RegReal . RealRegSingle . oReg) [0,1]
        3       -> map (RegReal . RealRegSingle . oReg) [0,1,2]
        4       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3]
        5       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4]
        6       -> map (RegReal . RealRegSingle . oReg) [0,1,2,3,4,5]
        _       -> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"


-- | All all the regs that could possibly be returned by argRegs
--
allArgRegs :: [Reg]
allArgRegs
        = map (RegReal . RealRegSingle) [oReg i | i <- [0..5]]


-- These are the regs that we cannot assume stay alive over a C call.
--      TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
--
callClobberedRegs :: [Reg]
callClobberedRegs
        = map (RegReal . RealRegSingle)
                (  oReg 7 :
                  [oReg i | i <- [0..5]] ++
                  [gReg i | i <- [1..7]] ++
                  [fReg i | i <- [0..31]] )



-- | Make a virtual reg with this format.
mkVirtualReg :: Unique -> Format -> VirtualReg
mkVirtualReg u format
        | not (isFloatFormat format)
        = VirtualRegI u

        | otherwise
        = case format of
                FF32    -> VirtualRegF u
                FF64    -> VirtualRegD u
                _       -> panic "mkVReg"


regDotColor :: RealReg -> SDoc
regDotColor reg
 = case classOfRealReg reg of
        RcInteger       -> text "blue"
        RcFloat         -> text "red"
        _other          -> text "green"