summaryrefslogtreecommitdiff
path: root/compiler/GHC/Platform/Reg.hs
blob: 5edd39df51d62f736db750e2ec4db644b345bb54 (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
-- | An architecture independent description of a register.
--      This needs to stay architecture independent because it is used
--      by NCGMonad and the register allocators, which are shared
--      by all architectures.
--
module GHC.Platform.Reg (
        RegNo,
        Reg(..),
        regPair,
        regSingle,
        realRegSingle,
        isRealReg,      takeRealReg,
        isVirtualReg,   takeVirtualReg,

        VirtualReg(..),
        renameVirtualReg,
        classOfVirtualReg,
        getHiVirtualRegFromLo,
        getHiVRegFromLo,

        RealReg(..),
        regNosOfRealReg,
        realRegsAlias,

        liftPatchFnToRegReg
)

where

import GHC.Prelude

import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Types.Unique
import GHC.Builtin.Uniques
import GHC.Platform.Reg.Class
import Data.List (intersect)

-- | An identifier for a primitive real machine register.
type RegNo
        = Int

-- VirtualRegs are virtual registers.  The register allocator will
--      eventually have to map them into RealRegs, or into spill slots.
--
--      VirtualRegs are allocated on the fly, usually to represent a single
--      value in the abstract assembly code (i.e. dynamic registers are
--      usually single assignment).
--
--      The  single assignment restriction isn't necessary to get correct code,
--      although a better register allocation will result if single
--      assignment is used -- because the allocator maps a VirtualReg into
--      a single RealReg, even if the VirtualReg has multiple live ranges.
--
--      Virtual regs can be of either class, so that info is attached.
--
data VirtualReg
        = VirtualRegI  {-# UNPACK #-} !Unique
        | VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register
        | VirtualRegF  {-# UNPACK #-} !Unique
        | VirtualRegD  {-# UNPACK #-} !Unique

        deriving (Eq, Show)

-- This is laborious, but necessary. We can't derive Ord because
-- Unique doesn't have an Ord instance. Note nonDetCmpUnique in the
-- implementation. See Note [No Ord for Unique]
-- This is non-deterministic but we do not currently support deterministic
-- code-generation. See Note [Unique Determinism and code generation]
instance Ord VirtualReg where
  compare (VirtualRegI a) (VirtualRegI b) = nonDetCmpUnique a b
  compare (VirtualRegHi a) (VirtualRegHi b) = nonDetCmpUnique a b
  compare (VirtualRegF a) (VirtualRegF b) = nonDetCmpUnique a b
  compare (VirtualRegD a) (VirtualRegD b) = nonDetCmpUnique a b

  compare VirtualRegI{} _ = LT
  compare _ VirtualRegI{} = GT
  compare VirtualRegHi{} _ = LT
  compare _ VirtualRegHi{} = GT
  compare VirtualRegF{} _ = LT
  compare _ VirtualRegF{} = GT



instance Uniquable VirtualReg where
        getUnique reg
         = case reg of
                VirtualRegI u   -> u
                VirtualRegHi u  -> u
                VirtualRegF u   -> u
                VirtualRegD u   -> u

instance Outputable VirtualReg where
        ppr reg
         = case reg of
                VirtualRegI  u  -> text "%vI_"   <> pprUniqueAlways u
                VirtualRegHi u  -> text "%vHi_"  <> pprUniqueAlways u
                -- this code is kinda wrong on x86
                -- because float and double occupy the same register set
                -- namely SSE2 register xmm0 .. xmm15
                VirtualRegF  u  -> text "%vFloat_"   <> pprUniqueAlways u
                VirtualRegD  u  -> text "%vDouble_"   <> pprUniqueAlways u



renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
renameVirtualReg u r
 = case r of
        VirtualRegI _   -> VirtualRegI  u
        VirtualRegHi _  -> VirtualRegHi u
        VirtualRegF _   -> VirtualRegF  u
        VirtualRegD _   -> VirtualRegD  u


classOfVirtualReg :: VirtualReg -> RegClass
classOfVirtualReg vr
 = case vr of
        VirtualRegI{}   -> RcInteger
        VirtualRegHi{}  -> RcInteger
        VirtualRegF{}   -> RcFloat
        VirtualRegD{}   -> RcDouble



-- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform
-- when supplied with the vreg for the lower-half of the quantity.
-- (NB. Not reversible).
getHiVirtualRegFromLo :: VirtualReg -> VirtualReg
getHiVirtualRegFromLo reg
 = case reg of
        -- makes a pseudo-unique with tag 'H'
        VirtualRegI u   -> VirtualRegHi (newTagUnique u 'H')
        _               -> panic "Reg.getHiVirtualRegFromLo"

getHiVRegFromLo :: Reg -> Reg
getHiVRegFromLo reg
 = case reg of
        RegVirtual  vr  -> RegVirtual (getHiVirtualRegFromLo vr)
        RegReal _       -> panic "Reg.getHiVRegFromLo"


------------------------------------------------------------------------------------
-- | RealRegs are machine regs which are available for allocation, in
--      the usual way.  We know what class they are, because that's part of
--      the processor's architecture.
--
--      RealRegPairs are pairs of real registers that are allocated together
--      to hold a larger value, such as with Double regs on SPARC.
--
data RealReg
        = RealRegSingle {-# UNPACK #-} !RegNo
        | RealRegPair   {-# UNPACK #-} !RegNo {-# UNPACK #-} !RegNo
        deriving (Eq, Show, Ord)

instance Uniquable RealReg where
        getUnique reg
         = case reg of
                RealRegSingle i         -> mkRegSingleUnique i
                RealRegPair r1 r2       -> mkRegPairUnique (r1 * 65536 + r2)

instance Outputable RealReg where
        ppr reg
         = case reg of
                RealRegSingle i         -> text "%r"  <> int i
                RealRegPair r1 r2       -> text "%r(" <> int r1
                                           <> vbar <> int r2 <> text ")"

regNosOfRealReg :: RealReg -> [RegNo]
regNosOfRealReg rr
 = case rr of
        RealRegSingle r1        -> [r1]
        RealRegPair   r1 r2     -> [r1, r2]


realRegsAlias :: RealReg -> RealReg -> Bool
realRegsAlias rr1 rr2
        = not $ null $ intersect (regNosOfRealReg rr1) (regNosOfRealReg rr2)

--------------------------------------------------------------------------------
-- | A register, either virtual or real
data Reg
        = RegVirtual !VirtualReg
        | RegReal    !RealReg
        deriving (Eq, Ord, Show)

regSingle :: RegNo -> Reg
regSingle regNo = RegReal (realRegSingle regNo)

realRegSingle :: RegNo -> RealReg
realRegSingle regNo = RealRegSingle regNo

regPair :: RegNo -> RegNo -> Reg
regPair regNo1 regNo2   = RegReal $ RealRegPair regNo1 regNo2


-- We like to have Uniques for Reg so that we can make UniqFM and UniqSets
-- in the register allocator.
instance Uniquable Reg where
        getUnique reg
         = case reg of
                RegVirtual vr   -> getUnique vr
                RegReal    rr   -> getUnique rr

-- | Print a reg in a generic manner
--      If you want the architecture specific names, then use the pprReg
--      function from the appropriate Ppr module.
instance Outputable Reg where
        ppr reg
         = case reg of
                RegVirtual vr   -> ppr vr
                RegReal    rr   -> ppr rr


isRealReg :: Reg -> Bool
isRealReg reg
 = case reg of
        RegReal _       -> True
        RegVirtual _    -> False

takeRealReg :: Reg -> Maybe RealReg
takeRealReg reg
 = case reg of
        RegReal rr      -> Just rr
        _               -> Nothing


isVirtualReg :: Reg -> Bool
isVirtualReg reg
 = case reg of
        RegReal _       -> False
        RegVirtual _    -> True

takeVirtualReg :: Reg -> Maybe VirtualReg
takeVirtualReg reg
 = case reg of
        RegReal _       -> Nothing
        RegVirtual vr   -> Just vr


-- | The patch function supplied by the allocator maps VirtualReg to RealReg
--      regs, but sometimes we want to apply it to plain old Reg.
--
liftPatchFnToRegReg  :: (VirtualReg -> RealReg) -> (Reg -> Reg)
liftPatchFnToRegReg patchF reg
 = case reg of
        RegVirtual vr   -> RegReal (patchF vr)
        RegReal _       -> reg