Merge remote branch 'origin/master'
[ghc-hetmet.git] / compiler / nativeGen / Reg.hs
1
2 -- | An architecture independent description of a register.
3 --      This needs to stay architecture independent because it is used
4 --      by NCGMonad and the register allocators, which are shared
5 --      by all architectures.
6 --
7 module Reg (
8         RegNo,
9         Reg(..),
10         regPair,
11         regSingle,
12         isRealReg,      takeRealReg,
13         isVirtualReg,   takeVirtualReg,
14         
15         VirtualReg(..),
16         renameVirtualReg,
17         classOfVirtualReg,
18         getHiVirtualRegFromLo,
19         getHiVRegFromLo,
20
21         RealReg(..),
22         regNosOfRealReg,
23         realRegsAlias,
24         
25         liftPatchFnToRegReg
26 )
27
28 where
29
30 import Outputable
31 import Unique
32 import RegClass
33 import Data.List
34
35 -- | An identifier for a primitive real machine register.
36 type RegNo 
37         = Int
38
39 -- VirtualRegs are virtual registers.  The register allocator will
40 --      eventually have to map them into RealRegs, or into spill slots.
41 --
42 --      VirtualRegs are allocated on the fly, usually to represent a single
43 --      value in the abstract assembly code (i.e. dynamic registers are
44 --      usually single assignment).  
45 --
46 --      The  single assignment restriction isn't necessary to get correct code,
47 --      although a better register allocation will result if single
48 --      assignment is used -- because the allocator maps a VirtualReg into
49 --      a single RealReg, even if the VirtualReg has multiple live ranges.
50 --
51 --      Virtual regs can be of either class, so that info is attached.
52 --
53 data VirtualReg
54         = VirtualRegI  {-# UNPACK #-} !Unique
55         | VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register
56         | VirtualRegF  {-# UNPACK #-} !Unique
57         | VirtualRegD  {-# UNPACK #-} !Unique
58         | VirtualRegSSE {-# UNPACK #-} !Unique
59         deriving (Eq, Show, Ord)
60
61 instance Uniquable VirtualReg where
62         getUnique reg
63          = case reg of
64                 VirtualRegI u   -> u
65                 VirtualRegHi u  -> u
66                 VirtualRegF u   -> u
67                 VirtualRegD u   -> u
68                 VirtualRegSSE u -> u
69
70 instance Outputable VirtualReg where
71         ppr reg
72          = case reg of
73                 VirtualRegI  u  -> text "%vI_"  <> pprUnique u
74                 VirtualRegHi u  -> text "%vHi_" <> pprUnique u
75                 VirtualRegF  u  -> text "%vF_"  <> pprUnique u
76                 VirtualRegD  u  -> text "%vD_"  <> pprUnique u
77                 VirtualRegSSE u -> text "%vSSE_" <> pprUnique u
78
79
80 renameVirtualReg :: Unique -> VirtualReg -> VirtualReg
81 renameVirtualReg u r
82  = case r of
83         VirtualRegI _   -> VirtualRegI  u
84         VirtualRegHi _  -> VirtualRegHi u
85         VirtualRegF _   -> VirtualRegF  u
86         VirtualRegD _   -> VirtualRegD  u
87         VirtualRegSSE _ -> VirtualRegSSE u
88
89
90 classOfVirtualReg :: VirtualReg -> RegClass
91 classOfVirtualReg vr
92  = case vr of
93         VirtualRegI{}   -> RcInteger
94         VirtualRegHi{}  -> RcInteger
95         VirtualRegF{}   -> RcFloat
96         VirtualRegD{}   -> RcDouble
97         VirtualRegSSE{} -> RcDoubleSSE
98
99
100 -- Determine the upper-half vreg for a 64-bit quantity on a 32-bit platform
101 -- when supplied with the vreg for the lower-half of the quantity.
102 -- (NB. Not reversible).
103 getHiVirtualRegFromLo :: VirtualReg -> VirtualReg
104 getHiVirtualRegFromLo reg
105  = case reg of
106         -- makes a pseudo-unique with tag 'H'
107         VirtualRegI u   -> VirtualRegHi (newTagUnique u 'H') 
108         _               -> panic "Reg.getHiVirtualRegFromLo"
109
110 getHiVRegFromLo :: Reg -> Reg
111 getHiVRegFromLo reg
112  = case reg of
113         RegVirtual  vr  -> RegVirtual (getHiVirtualRegFromLo vr)
114         RegReal _       -> panic "Reg.getHiVRegFromLo"
115         
116
117 ------------------------------------------------------------------------------------
118 -- | RealRegs are machine regs which are available for allocation, in
119 --      the usual way.  We know what class they are, because that's part of
120 --      the processor's architecture.
121 --
122 --      RealRegPairs are pairs of real registers that are allocated together
123 --      to hold a larger value, such as with Double regs on SPARC.
124 --
125 data RealReg
126         = RealRegSingle {-# UNPACK #-} !RegNo
127         | RealRegPair   {-# UNPACK #-} !RegNo {-# UNPACK #-} !RegNo
128         deriving (Eq, Show, Ord)
129
130 instance Uniquable RealReg where
131         getUnique reg
132          = case reg of
133                 RealRegSingle i         -> mkRegSingleUnique i
134                 RealRegPair r1 r2       -> mkRegPairUnique (r1 * 65536 + r2)
135
136 instance Outputable RealReg where
137         ppr reg
138          = case reg of
139                 RealRegSingle i         -> text "%r"    <> int i
140                 RealRegPair r1 r2       -> text "%r(" <> int r1 <> text "|" <> int r2 <> text ")"
141
142 regNosOfRealReg :: RealReg -> [RegNo]
143 regNosOfRealReg rr
144  = case rr of
145         RealRegSingle r1        -> [r1]
146         RealRegPair   r1 r2     -> [r1, r2]
147         
148
149 realRegsAlias :: RealReg -> RealReg -> Bool
150 realRegsAlias rr1 rr2
151         = not $ null $ intersect (regNosOfRealReg rr1) (regNosOfRealReg rr2)
152
153 --------------------------------------------------------------------------------
154 -- | A register, either virtual or real
155 data Reg
156         = RegVirtual !VirtualReg
157         | RegReal    !RealReg
158         deriving (Eq, Ord)
159
160 regSingle :: RegNo -> Reg
161 regSingle regNo         = RegReal $ RealRegSingle regNo
162
163 regPair :: RegNo -> RegNo -> Reg
164 regPair regNo1 regNo2   = RegReal $ RealRegPair regNo1 regNo2
165
166
167 -- We like to have Uniques for Reg so that we can make UniqFM and UniqSets 
168 -- in the register allocator.
169 instance Uniquable Reg where
170         getUnique reg
171          = case reg of
172                 RegVirtual vr   -> getUnique vr
173                 RegReal    rr   -> getUnique rr
174         
175 -- | Print a reg in a generic manner
176 --      If you want the architecture specific names, then use the pprReg 
177 --      function from the appropriate Ppr module.
178 instance Outputable Reg where
179         ppr reg
180          = case reg of
181                 RegVirtual vr   -> ppr vr
182                 RegReal    rr   -> ppr rr
183
184
185 isRealReg :: Reg -> Bool
186 isRealReg reg 
187  = case reg of
188         RegReal _       -> True
189         RegVirtual _    -> False
190
191 takeRealReg :: Reg -> Maybe RealReg
192 takeRealReg reg
193  = case reg of
194         RegReal rr      -> Just rr
195         _               -> Nothing
196
197
198 isVirtualReg :: Reg -> Bool
199 isVirtualReg reg
200  = case reg of
201         RegReal _       -> False
202         RegVirtual _    -> True
203
204 takeVirtualReg :: Reg -> Maybe VirtualReg
205 takeVirtualReg reg
206  = case reg of
207         RegReal _       -> Nothing
208         RegVirtual vr   -> Just vr
209
210
211 -- | The patch function supplied by the allocator maps VirtualReg to RealReg
212 --      regs, but sometimes we want to apply it to plain old Reg.
213 --
214 liftPatchFnToRegReg  :: (VirtualReg -> RealReg) -> (Reg -> Reg)
215 liftPatchFnToRegReg patchF reg
216  = case reg of
217         RegVirtual vr   -> RegReal (patchF vr)
218         RegReal _       -> reg
219         
220