Regs.hs 8.14 KB
Newer Older
1
2
3
4
5
6
7
8
9
10
11
12
13
-- -----------------------------------------------------------------------------
--
-- (c) The University of Glasgow 1994-2004
-- 
-- Machine-specific info about registers.
-- 
-- Also includes stuff about immediate operands, which are
-- often/usually quite entangled with registers.
-- 
-- -----------------------------------------------------------------------------

#include "nativeGen/NCG.h"

14
module Regs (
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
	--------------------------------
	-- Generic things, shared by all architectures.
	module RegsBase,	
	getHiVRegFromLo,
	get_GlobalReg_reg_or_addr,
	allocatableRegs,
	allocatableRegsInClass,
	trivColorable,

	--------------------------------
	-- Things that are defined by the arch specific module.
	--

	-- sizes
	Size(..),
	intSize, 
	floatSize, 
	isFloatSize, 
	wordSize, 
	cmmTypeSize, 
	sizeToWidth,
	mkVReg,

	-- immediates
	Imm(..), 
	strImmLit, 
	litToImm,

	-- addressing modes
	AddrMode(..),
	addrOffset,

	-- registers
	spRel,
	argRegs, 
	allArgRegs, 
	callClobberedRegs,
	allMachRegNos,
	regClass,
	showReg,

	-- machine specific things
#if   powerpc_TARGET_ARCH
	allFPArgRegs,
	fits16Bits,
	makeImmediate,
61
	fReg,
62
63
	sp, r3, r4, r27, r28, f1, f20, f21,

Ian Lynagh's avatar
Ian Lynagh committed
64
#elif i386_TARGET_ARCH || x86_64_TARGET_ARCH
65
66
67
68
69
70
71
72
73
74
	EABase(..), EAIndex(..), addrModeRegs,
	
	eax, ebx, ecx, edx, esi, edi, ebp, esp,
	fake0, fake1, fake2, fake3, fake4, fake5,
	rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp,
	r8, r9, r10, r11, r12, r13, r14, r15,
  	xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,
  	xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15,
	xmm,

75
76
77
	ripRel,
	allFPArgRegs,

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
#elif sparc_TARGET_ARCH
	fpRel,
	fits13Bits, 
	largeOffsetError,
	gReg, iReg, lReg, oReg, fReg,
	fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27,
	nCG_FirstFloatReg,
#endif
	-- horror show
	freeReg,
	globalRegMaybe	
) 

where

#include "HsVersions.h"
#include "../includes/MachRegs.h"

import Cmm
import CgUtils          ( get_GlobalReg_addr )
import Outputable	( Outputable(..), pprPanic )
import qualified Outputable
import Panic
import Unique
import UniqSet
import FastTypes
import FastBool
import UniqFM


import RegsBase

#if   alpha_TARGET_ARCH
import Alpha.Regs
#elif powerpc_TARGET_ARCH
import PPC.Regs
#elif i386_TARGET_ARCH || x86_64_TARGET_ARCH
import X86.Regs
#elif sparc_TARGET_ARCH
import SPARC.Regs
#else
119
#error "Regs: not defined for this architecture"
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
#endif



instance Show Reg where
	show (RealReg i)      = showReg i
	show (VirtualRegI u)  = "%vI_" ++ show u
	show (VirtualRegHi u) = "%vHi_" ++ show u
	show (VirtualRegF u)  = "%vF_" ++ show u
	show (VirtualRegD u)  = "%vD_" ++ show u

instance Outputable Reg where
	ppr r = Outputable.text (show r)


-- 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).
getHiVRegFromLo :: Reg -> Reg
getHiVRegFromLo (VirtualRegI u) 
   = VirtualRegHi (newTagUnique u 'H') -- makes a pseudo-unique with tag 'H'

getHiVRegFromLo other 
   = pprPanic "getHiVRegFromLo" (ppr other)

-- -----------------------------------------------------------------------------
-- Global registers

-- We map STG registers onto appropriate CmmExprs.  Either they map
-- to real machine registers or stored as offsets from BaseReg.  Given
-- a GlobalReg, get_GlobalReg_reg_or_addr produces either the real
-- register it is in, on this platform, or a CmmExpr denoting the
-- address in the register table holding it.
-- (See also get_GlobalReg_addr in CgUtils.)

get_GlobalReg_reg_or_addr       :: GlobalReg -> Either Reg CmmExpr
get_GlobalReg_reg_or_addr mid
   = case globalRegMaybe mid of
        Just rr -> Left rr
        Nothing -> Right (get_GlobalReg_addr mid)


-- allocatableRegs is allMachRegNos with the fixed-use regs removed.
-- i.e., these are the regs for which we are prepared to allow the
-- register allocator to attempt to map VRegs to.
allocatableRegs :: [RegNo]
allocatableRegs
   = let isFree i = isFastTrue (freeReg i)
     in  filter isFree allMachRegNos


-- | The number of regs in each class.
--	We go via top level CAFs to ensure that we're not recomputing
--	the length of these lists each time the fn is called.
allocatableRegsInClass :: RegClass -> Int
allocatableRegsInClass cls
 = case cls of
 	RcInteger	-> allocatableRegsInteger
	RcDouble	-> allocatableRegsDouble
179
	RcFloat		-> panic "Regs.allocatableRegsInClass: no match\n"
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

allocatableRegsInteger :: Int
allocatableRegsInteger	
	= length $ filter (\r -> regClass r == RcInteger) 
		 $ map RealReg allocatableRegs

allocatableRegsDouble :: Int
allocatableRegsDouble
	= length $ filter (\r -> regClass r == RcDouble) 
		 $ map RealReg allocatableRegs



-- trivColorable ---------------------------------------------------------------

-- trivColorable function for the graph coloring allocator
--	This gets hammered by scanGraph during register allocation,
--	so needs to be fairly efficient.
--
--	NOTE: 	This only works for arcitectures with just RcInteger and RcDouble
--		(which are disjoint) ie. x86, x86_64 and ppc
--

--	BL 2007/09
--	Doing a nice fold over the UniqSet makes trivColorable use
--	32% of total compile time and 42% of total alloc when compiling SHA1.lhs from darcs.
{-
trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
trivColorable classN conflicts exclusions
 = let

	acc :: Reg -> (Int, Int) -> (Int, Int)
	acc r (cd, cf)	
	 = case regClass r of
		RcInteger	-> (cd+1, cf)
		RcDouble	-> (cd,   cf+1)
216
		_		-> panic "Regs.trivColorable: reg class not handled"
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

	tmp			= foldUniqSet acc (0, 0) conflicts
	(countInt,  countFloat)	= foldUniqSet acc tmp    exclusions

	squeese		= worst countInt   classN RcInteger
			+ worst countFloat classN RcDouble

   in	squeese < allocatableRegsInClass classN

-- | Worst case displacement
--	node N of classN has n neighbors of class C.
--
--	We currently only have RcInteger and RcDouble, which don't conflict at all.
--	This is a bit boring compared to what's in RegArchX86.
--
worst :: Int -> RegClass -> RegClass -> Int
worst n classN classC
 = case classN of
 	RcInteger
	 -> case classC of
	 	RcInteger	-> min n (allocatableRegsInClass RcInteger)
		RcDouble	-> 0
		
	RcDouble
	 -> case classC of
	 	RcDouble	-> min n (allocatableRegsInClass RcDouble)
		RcInteger	-> 0
-}


-- The number of allocatable regs is hard coded here so we can do a fast comparision
-- in trivColorable. It's ok if these numbers are _less_ than the actual number of
-- free regs, but they can't be more or the register conflict graph won't color.
--
-- There is an allocatableRegsInClass :: RegClass -> Int, but doing the unboxing
-- is too slow for us here.
--
254
-- Compare Regs.freeRegs  and MachRegs.h to get these numbers.
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
--
#if i386_TARGET_ARCH
#define ALLOCATABLE_REGS_INTEGER (_ILIT(3))
#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(6))
#define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))

#elif x86_64_TARGET_ARCH
#define ALLOCATABLE_REGS_INTEGER (_ILIT(5))
#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(2))
#define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))

#elif powerpc_TARGET_ARCH
#define ALLOCATABLE_REGS_INTEGER (_ILIT(16))
#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(26))
#define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))

#elif sparc_TARGET_ARCH
#define ALLOCATABLE_REGS_INTEGER (_ILIT(3))
#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(6))
#define ALLOCATABLE_REGS_FLOAT   (_ILIT(0))

#else
#error ToDo: define ALLOCATABLE_REGS_INTEGER and ALLOCATABLE_REGS_DOUBLE
#endif

trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
trivColorable _ conflicts exclusions
 = {-# SCC "trivColorable" #-}
   let
	isSqueesed cI cF ufm
	  = case ufm of
		NodeUFM _ _ left right
		 -> case isSqueesed cI cF right of
		 	(# s, cI', cF' #)
			 -> case s of
			 	False	-> isSqueesed cI' cF' left
				True	-> (# True, cI', cF' #)

		LeafUFM _ reg
		 -> case regClass reg of
		 	RcInteger
			 -> case cI +# _ILIT(1) of
			  	cI' -> (# cI' >=# ALLOCATABLE_REGS_INTEGER, cI', cF #)

			RcDouble
			 -> case cF +# _ILIT(1) of
			 	cF' -> (# cF' >=# ALLOCATABLE_REGS_DOUBLE,  cI, cF' #)

			RcFloat 
			 -> case cF +# _ILIT(1) of
			 	cF' -> (# cF' >=# ALLOCATABLE_REGS_FLOAT,   cI, cF' #)

		EmptyUFM
		 ->	(# False, cI, cF #)

   in case isSqueesed (_ILIT(0)) (_ILIT(0)) conflicts of
	(# False, cI', cF' #)
	 -> case isSqueesed cI' cF' exclusions of
		(# s, _, _ #)	-> not s

	(# True, _, _ #)
	 -> False