NCG: Split MachRegs.hs into arch specific modules

compiler/ghc.cabal.in

@@ -461,6 +461,11 @@ Library
             PPC.Instr
             SPARC.Instr
             MachRegs
+            RegsBase
+            X86.Regs
+            PPC.Regs
+            SPARC.Regs
+            Alpha.Regs
             NCGMonad
             PositionIndependentCode
             PprMach

compiler/nativeGen/Alpha/Regs.hs

+-- -----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow 1994-2004
+-- 
+-- Alpha support is rotted and incomplete.
+-- -----------------------------------------------------------------------------
+
+
+module Alpha.Regs (
+{-
+	Size(..),
+	AddrMode(..),
+	fits8Bits,
+	fReg,
+	gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh
+-}
+)
+
+where
+
+{-
+#include "nativeGen/NCG.h"
+#include "HsVersions.h"
+#include "../includes/MachRegs.h"
+
+import RegsBase
+
+import BlockId
+import Cmm
+import CgUtils          ( get_GlobalReg_addr )
+import CLabel           ( CLabel, mkMainCapabilityLabel )
+import Pretty
+import Outputable	( Outputable(..), pprPanic, panic )
+import qualified Outputable
+import Unique
+import UniqSet
+import Constants
+import FastTypes
+import FastBool
+import UniqFM
+
+
+data Size
+	= B	    -- byte
+	| Bu
+--	| W	    -- word (2 bytes): UNUSED
+--	| Wu    -- : UNUSED
+	| L	    -- longword (4 bytes)
+	| Q	    -- quadword (8 bytes)
+--	| FF    -- VAX F-style floating pt: UNUSED
+--	| GF    -- VAX G-style floating pt: UNUSED
+--	| DF    -- VAX D-style floating pt: UNUSED
+--	| SF    -- IEEE single-precision floating pt: UNUSED
+	| TF    -- IEEE double-precision floating pt
+	deriving Eq
+
+
+data AddrMode
+	= AddrImm	Imm
+	| AddrReg	Reg
+	| AddrRegImm	Reg Imm
+
+
+addrOffset :: AddrMode -> Int -> Maybe AddrMode
+addrOffset addr off
+  = case addr of
+      _ -> panic "MachMisc.addrOffset not defined for Alpha"
+
+fits8Bits :: Integer -> Bool
+fits8Bits i = i >= -256 && i < 256
+
+
+-- The Alpha has 64 registers of interest; 32 integer registers and 32 floating
+-- point registers.  The mapping of STG registers to alpha machine registers
+-- is defined in StgRegs.h.  We are, of course, prepared for any eventuality.
+
+fReg :: Int -> RegNo
+fReg x = (32 + x)
+
+v0, f0, ra, pv, gp, sp, zeroh :: Reg
+v0    = realReg 0
+f0    = realReg (fReg 0)
+ra    = FixedReg ILIT(26)
+pv    = t12
+gp    = FixedReg ILIT(29)
+sp    = FixedReg ILIT(30)
+zeroh = FixedReg ILIT(31) -- "zero" is used in 1.3 (MonadZero method)
+
+t9, t10, t11, t12 :: Reg
+t9  = realReg 23
+t10 = realReg 24
+t11 = realReg 25
+t12 = realReg 27
+
+
+#define f0 32
+#define f1 33
+#define f2 34
+#define f3 35
+#define f4 36
+#define f5 37
+#define f6 38
+#define f7 39
+#define f8 40
+#define f9 41
+#define f10 42
+#define f11 43
+#define f12 44
+#define f13 45
+#define f14 46
+#define f15 47
+#define f16 48
+#define f17 49
+#define f18 50
+#define f19 51
+#define f20 52
+#define f21 53
+#define f22 54
+#define f23 55
+#define f24 56
+#define f25 57
+#define f26 58
+#define f27 59
+#define f28 60
+#define f29 61
+#define f30 62
+#define f31 63
+
+
+-- allMachRegs is the complete set of machine regs.
+allMachRegNos :: [RegNo]
+allMachRegNos	= [0..63]
+
+
+-- these are the regs which we cannot assume stay alive over a
+-- C call.  
+callClobberedRegs :: [Reg]
+callClobberedRegs
+ =	[0, 1, 2, 3, 4, 5, 6, 7, 8,
+	 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29,
+	 fReg 0, fReg 1, fReg 10, fReg 11, fReg 12, fReg 13, fReg 14, fReg 15,
+	 fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21, fReg 22, fReg 23,
+	 fReg 24, fReg 25, fReg 26, fReg 27, fReg 28, fReg 29, fReg 30]
+
+
+-- argRegs is the set of regs which are read for an n-argument call to C.
+-- For archs which pass all args on the stack (x86), is empty.
+-- Sparc passes up to the first 6 args in regs.
+-- Dunno about Alpha.
+argRegs :: RegNo -> [Reg]
+
+argRegs 0 = []
+argRegs 1 = freeMappedRegs [16, fReg 16]
+argRegs 2 = freeMappedRegs [16, 17, fReg 16, fReg 17]
+argRegs 3 = freeMappedRegs [16, 17, 18, fReg 16, fReg 17, fReg 18]
+argRegs 4 = freeMappedRegs [16, 17, 18, 19, fReg 16, fReg 17, fReg 18, fReg 19]
+argRegs 5 = freeMappedRegs [16, 17, 18, 19, 20, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20]
+argRegs 6 = freeMappedRegs [16, 17, 18, 19, 20, 21, fReg 16, fReg 17, fReg 18, fReg 19, fReg 20, fReg 21]
+argRegs _ = panic "MachRegs.argRegs(alpha): don't know about >6 arguments!"
+
+
+-- all of the arg regs ??
+allArgRegs :: [(Reg, Reg)]
+allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
+
+
+-- horror show -----------------------------------------------------------------
+
+freeReg :: RegNo -> FastBool
+
+freeReg 26 = fastBool False  -- return address (ra)
+freeReg 28 = fastBool False  -- reserved for the assembler (at)
+freeReg 29 = fastBool False  -- global pointer (gp)
+freeReg 30 = fastBool False  -- stack pointer (sp)
+freeReg 31 = fastBool False  -- always zero (zeroh)
+freeReg 63 = fastBool False  -- always zero (f31)
+
+#ifdef REG_Base
+freeReg REG_Base = fastBool False
+#endif
+#ifdef REG_R1
+freeReg REG_R1   = fastBool False
+#endif	
+#ifdef REG_R2  
+freeReg REG_R2   = fastBool False
+#endif	
+#ifdef REG_R3  
+freeReg REG_R3   = fastBool False
+#endif	
+#ifdef REG_R4  
+freeReg REG_R4   = fastBool False
+#endif	
+#ifdef REG_R5  
+freeReg REG_R5   = fastBool False
+#endif	
+#ifdef REG_R6  
+freeReg REG_R6   = fastBool False
+#endif	
+#ifdef REG_R7  
+freeReg REG_R7   = fastBool False
+#endif	
+#ifdef REG_R8  
+freeReg REG_R8   = fastBool False
+#endif
+#ifdef REG_F1
+freeReg REG_F1 = fastBool False
+#endif
+#ifdef REG_F2
+freeReg REG_F2 = fastBool False
+#endif
+#ifdef REG_F3
+freeReg REG_F3 = fastBool False
+#endif
+#ifdef REG_F4
+freeReg REG_F4 = fastBool False
+#endif
+#ifdef REG_D1
+freeReg REG_D1 = fastBool False
+#endif
+#ifdef REG_D2
+freeReg REG_D2 = fastBool False
+#endif
+#ifdef REG_Sp 
+freeReg REG_Sp   = fastBool False
+#endif 
+#ifdef REG_Su
+freeReg REG_Su   = fastBool False
+#endif 
+#ifdef REG_SpLim 
+freeReg REG_SpLim = fastBool False
+#endif 
+#ifdef REG_Hp 
+freeReg REG_Hp   = fastBool False
+#endif
+#ifdef REG_HpLim
+freeReg REG_HpLim = fastBool False
+#endif
+freeReg n               = fastBool True
+
+
+--  | Returns 'Nothing' if this global register is not stored
+-- in a real machine register, otherwise returns @'Just' reg@, where
+-- reg is the machine register it is stored in.
+
+globalRegMaybe :: GlobalReg -> Maybe Reg
+
+#ifdef REG_Base
+globalRegMaybe BaseReg			= Just (RealReg REG_Base)
+#endif
+#ifdef REG_R1
+globalRegMaybe (VanillaReg 1 _)		= Just (RealReg REG_R1)
+#endif 
+#ifdef REG_R2 
+globalRegMaybe (VanillaReg 2 _)		= Just (RealReg REG_R2)
+#endif 
+#ifdef REG_R3 
+globalRegMaybe (VanillaReg 3 _) 	= Just (RealReg REG_R3)
+#endif 
+#ifdef REG_R4 
+globalRegMaybe (VanillaReg 4 _)		= Just (RealReg REG_R4)
+#endif 
+#ifdef REG_R5 
+globalRegMaybe (VanillaReg 5 _)		= Just (RealReg REG_R5)
+#endif 
+#ifdef REG_R6 
+globalRegMaybe (VanillaReg 6 _)		= Just (RealReg REG_R6)
+#endif 
+#ifdef REG_R7 
+globalRegMaybe (VanillaReg 7 _)		= Just (RealReg REG_R7)
+#endif 
+#ifdef REG_R8 
+globalRegMaybe (VanillaReg 8 _)		= Just (RealReg REG_R8)
+#endif
+#ifdef REG_R9 
+globalRegMaybe (VanillaReg 9 _)		= Just (RealReg REG_R9)
+#endif
+#ifdef REG_R10 
+globalRegMaybe (VanillaReg 10 _)	= Just (RealReg REG_R10)
+#endif
+#ifdef REG_F1
+globalRegMaybe (FloatReg 1)		= Just (RealReg REG_F1)
+#endif				 	
+#ifdef REG_F2			 	
+globalRegMaybe (FloatReg 2)		= Just (RealReg REG_F2)
+#endif				 	
+#ifdef REG_F3			 	
+globalRegMaybe (FloatReg 3)		= Just (RealReg REG_F3)
+#endif				 	
+#ifdef REG_F4			 	
+globalRegMaybe (FloatReg 4)		= Just (RealReg REG_F4)
+#endif				 	
+#ifdef REG_D1			 	
+globalRegMaybe (DoubleReg 1)		= Just (RealReg REG_D1)
+#endif				 	
+#ifdef REG_D2			 	
+globalRegMaybe (DoubleReg 2)		= Just (RealReg REG_D2)
+#endif
+#ifdef REG_Sp	    
+globalRegMaybe Sp		   	= Just (RealReg REG_Sp)
+#endif
+#ifdef REG_Lng1			 	
+globalRegMaybe (LongReg 1)		= Just (RealReg REG_Lng1)
+#endif				 	
+#ifdef REG_Lng2			 	
+globalRegMaybe (LongReg 2)		= Just (RealReg REG_Lng2)
+#endif
+#ifdef REG_SpLim	    			
+globalRegMaybe SpLim		   	= Just (RealReg REG_SpLim)
+#endif	    				
+#ifdef REG_Hp	   			
+globalRegMaybe Hp		   	= Just (RealReg REG_Hp)
+#endif	    				
+#ifdef REG_HpLim      			
+globalRegMaybe HpLim		   	= Just (RealReg REG_HpLim)
+#endif	    				
+#ifdef REG_CurrentTSO      			
+globalRegMaybe CurrentTSO	   	= Just (RealReg REG_CurrentTSO)
+#endif	    				
+#ifdef REG_CurrentNursery      			
+globalRegMaybe CurrentNursery	   	= Just (RealReg REG_CurrentNursery)
+#endif	    				
+globalRegMaybe _		   	= Nothing
+
+-}

compiler/nativeGen/MachRegs.hs

+-- -----------------------------------------------------------------------------
+--
+-- (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"
+
+module MachRegs (
+	--------------------------------
+	-- 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,
+	freg,
+	sp, r3, r4, r27, r28, f1, f20, f21,
+
+#elif i386_TARGET_ARCH
+	EABase(..), EAIndex(..), addrModeRegs,
+	
+	eax, ebx, ecx, edx, esi, edi, ebp, esp,
+	fake0, fake1, fake2, fake3, fake4, fake5,
+
+#elif i386_64_TARGET_ARCH
+	EABase(..), EAIndex(..), addrModeRegs, 
+
+	ripRel,
+	allFPArgRegs,
+	
+	rax, rbx, rcx, rdx, rsi, rdi, rbp, rsp,
+	eax, ebx, ecx, edx, esi, edi, ebp, esp,
+	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,
+
+#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
+#error "MachRegs: not defined for this architecture"
+#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
+	RcFloat		-> panic "MachRegs.allocatableRegsInClass: no match\n"
+
+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)
+		_		-> panic "MachRegs.trivColorable: reg class not handled"
+
+	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.
+--
+-- Compare MachRegs.freeRegs  and MachRegs.h to get these numbers.
+--
+#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