NCG: Split MachRegs.hs into arch specific modules

8 files changed, 2607 insertions, 1591 deletions

diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 8fd470ca3c..f14961aed4 100644
--- a/compiler/ghc.cabal.in
+++ b/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
diff --git a/compiler/nativeGen/Alpha/Regs.hs b/compiler/nativeGen/Alpha/Regs.hs
new file mode 100644
index 0000000000..0a5c24e65a
--- /dev/null
+++ b/compiler/nativeGen/Alpha/Regs.hs
@@ -0,0 +1,324 @@
+-- -----------------------------------------------------------------------------
+--
+-- (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
+
+-}
diff --git a/compiler/nativeGen/MachRegs.hs b/compiler/nativeGen/MachRegs.hs
new file mode 100644
index 0000000000..828a3bcf4a
--- /dev/null
+++ b/compiler/nativeGen/MachRegs.hs
@@ -0,0 +1,323 @@
+-- -----------------------------------------------------------------------------
+--
+-- (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
+		 -> 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
+
+
diff --git a/compiler/nativeGen/MachRegs.lhs b/compiler/nativeGen/MachRegs.lhs
deleted file mode 100644
index f1f48f52cc..0000000000
--- a/compiler/nativeGen/MachRegs.lhs
+++ /dev/null
@@ -1,1591 +0,0 @@
--- -----------------------------------------------------------------------------
---
--- (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.
--- 
--- (Immediates could be untangled from registers at some cost in tangled
--- modules --- the pleasure has been foregone.)
--- 
--- -----------------------------------------------------------------------------
-
-\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
-#include "nativeGen/NCG.h"
-
-module MachRegs (
-
-	-- * Sizes
-	Size(..), intSize, floatSize, isFloatSize, 
-		  wordSize, cmmTypeSize, sizeToWidth,
-
-	-- * Immediate values
-	Imm(..), strImmLit, litToImm,
-
-	-- * Addressing modes
-	AddrMode(..),
-	addrOffset,
-
-	-- * The 'Reg' type
-	RegNo,
-	Reg(..), isRealReg, isVirtualReg, renameVirtualReg,
-        RegClass(..), regClass,
-	trivColorable,
-	getHiVRegFromLo, 
-	mkVReg,
-
-	-- * Global registers
-        get_GlobalReg_reg_or_addr,
-
-	-- * Machine-dependent register-related stuff
-        allocatableRegs, argRegs, allArgRegs, callClobberedRegs,
-	allocatableRegsInClass,
-	freeReg,
-	spRel,
-
-#if alpha_TARGET_ARCH
-	fits8Bits,
-	fReg,
-	gp, pv, ra, sp, t9, t10, t11, t12, v0, f0, zeroh,
-#endif
-#if i386_TARGET_ARCH
-	EABase(..), EAIndex(..),
-	eax, ebx, ecx, edx, esi, edi, ebp, esp,
-	fake0, fake1, fake2, fake3, fake4, fake5,
-	addrModeRegs,
-#endif
-#if x86_64_TARGET_ARCH
-	EABase(..), EAIndex(..), ripRel,
-	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,
-	addrModeRegs, allFPArgRegs,
-#endif
-#if sparc_TARGET_ARCH
-	fits13Bits, 
-	fpRel, gReg, iReg, lReg, oReg, fReg, largeOffsetError,
-	fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27,
-#endif
-#if powerpc_TARGET_ARCH
-	allFPArgRegs,
-	makeImmediate,
-	sp,
-	r3, r4, r27, r28,
-	f1, f20, f21,
-#endif
-    ) where
-
-#include "HsVersions.h"
-
-#if i386_TARGET_ARCH
-# define STOLEN_X86_REGS 4
--- HACK: go for the max
-#endif
-
-#include "../includes/MachRegs.h"
-
-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
-
-#if powerpc_TARGET_ARCH
-import Data.Word	( Word8, Word16, Word32 )
-import Data.Int 	( Int8, Int16, Int32 )
-#endif
-
--- -----------------------------------------------------------------------------
--- Sizes on this architecture
--- 
--- A Size is usually a combination of width and class
-
--- It looks very like the old MachRep, but it's now of purely local
--- significance, here in the native code generator.  You can change it
--- without global consequences.
---
--- A major use is as an opcode qualifier; thus the opcode 
---	mov.l a b
--- might be encoded 
--- 	MOV II32 a b
--- where the Size field encodes the ".l" part.
-
--- ToDo: it's not clear to me that we need separate signed-vs-unsigned sizes
--- here.  I've removed them from the x86 version, we'll see what happens --SDM
-
--- ToDo: quite a few occurrences of Size could usefully be replaced by Width
-
-#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH
-data Size	-- For these three, the "size" also gives the int/float
-		-- distinction, because the instructions for int/float
-		-- differ only in their suffices
-  = II8 | II16 | II32 | II64 | FF32 | FF64 | FF80
-  deriving Eq
-
-intSize, floatSize :: Width -> Size
-intSize W8 = II8
-intSize W16 = II16
-intSize W32 = II32
-intSize W64 = II64
-intSize other = pprPanic "MachInstrs.intSize" (ppr other)
-
-floatSize W32 = FF32
-floatSize W64 = FF64
-floatSize other = pprPanic "MachInstrs.intSize" (ppr other)
-
-wordSize :: Size
-wordSize = intSize wordWidth
-
-sizeToWidth :: Size -> Width
-sizeToWidth II8  = W8
-sizeToWidth II16 = W16
-sizeToWidth II32 = W32
-sizeToWidth II64 = W64
-sizeToWidth FF32 = W32
-sizeToWidth FF64 = W64
-sizeToWidth _ = panic "MachInstrs.sizeToWidth"
-
-cmmTypeSize :: CmmType -> Size
-cmmTypeSize ty | isFloatType ty = floatSize (typeWidth ty)
-	       | otherwise	= intSize (typeWidth ty)
-
-isFloatSize :: Size -> Bool
-isFloatSize FF32 = True
-isFloatSize FF64 = True
-isFloatSize FF80 = True
-isFloatSize other = False
-#endif
-
-#if alpha_TARGET_ARCH
-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
-#endif
-
-#if sparc_TARGET_ARCH /* || powerpc_TARGET_ARCH */
-data Size
-    = II8     -- byte (signed)
---    | II8u    -- byte (unsigned)
-    | II16    -- halfword (signed, 2 bytes)
---   | II16u   -- halfword (unsigned, 2 bytes)
-    | II32    -- word (4 bytes)
-    | II64    -- word (8 bytes)
-    | FF32    -- IEEE single-precision floating pt
-    | FF64    -- IEEE single-precision floating pt
-  deriving Eq
-
-
-intSize, floatSize :: Width -> Size
-intSize W8  = II8
---intSize W16 = II16u
-intSize W16 = II16
-intSize W32 = II32
-intSize W64 = II64
-intSize other = pprPanic "MachInstrs.intSize" (ppr other)
-
-floatSize W32 = FF32
-floatSize W64 = FF64
-floatSize other = pprPanic "MachInstrs.intSize" (ppr other)
-
-wordSize :: Size
-wordSize = intSize wordWidth
-
-isFloatSize :: Size -> Bool
-isFloatSize FF32	= True
-isFloatSize FF64	= True
-isFloatSize _		= False
-
-cmmTypeSize :: CmmType -> Size
-cmmTypeSize ty | isFloatType ty = floatSize (typeWidth ty)
-	       | otherwise	= intSize (typeWidth ty)
-
-sizeToWidth :: Size -> Width
-sizeToWidth size
- = case size of
- 	II8		-> W8
---	II8u		-> W8
-	II16		-> W16
---	II16u		-> W16
-	II32		-> W32
-	II64		-> W64
-	FF32		-> W32
-	FF64		-> W64
-
-
-#endif
-
--- -----------------------------------------------------------------------------
--- Immediates
-
-data Imm
-  = ImmInt	Int
-  | ImmInteger	Integer	    -- Sigh.
-  | ImmCLbl	CLabel	    -- AbstractC Label (with baggage)
-  | ImmLit	Doc	    -- Simple string
-  | ImmIndex    CLabel Int
-  | ImmFloat	Rational
-  | ImmDouble	Rational
-  | ImmConstantSum Imm Imm
-  | ImmConstantDiff Imm Imm
-#if sparc_TARGET_ARCH
-  | LO Imm		    {- Possible restrictions... -}
-  | HI Imm
-#endif
-#if powerpc_TARGET_ARCH
-  | LO Imm
-  | HI Imm
-  | HA Imm	{- high halfword adjusted -}
-#endif
-strImmLit s = ImmLit (text s)
-
-litToImm :: CmmLit -> Imm
-litToImm (CmmInt i w)        = ImmInteger (narrowS w i)
-                -- narrow to the width: a CmmInt might be out of
-                -- range, but we assume that ImmInteger only contains
-                -- in-range values.  A signed value should be fine here.
-litToImm (CmmFloat f W32)    = ImmFloat f
-litToImm (CmmFloat f W64)    = ImmDouble f
-litToImm (CmmLabel l)        = ImmCLbl l
-litToImm (CmmLabelOff l off) = ImmIndex l off
-litToImm (CmmLabelDiffOff l1 l2 off)
-                             = ImmConstantSum
-                               (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
-                               (ImmInt off)
-litToImm (CmmBlock id)       = ImmCLbl (infoTblLbl id)
-
--- -----------------------------------------------------------------------------
--- Addressing modes
-
-data AddrMode
-#if alpha_TARGET_ARCH
-  = AddrImm	Imm
-  | AddrReg	Reg
-  | AddrRegImm	Reg Imm
-#endif
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-  = AddrBaseIndex	EABase EAIndex Displacement
-  | ImmAddr		Imm Int
-
-data EABase       = EABaseNone  | EABaseReg Reg | EABaseRip
-data EAIndex      = EAIndexNone | EAIndex Reg Int
-type Displacement = Imm
-#endif
-
-#if sparc_TARGET_ARCH
-  = AddrRegReg	Reg Reg
-  | AddrRegImm	Reg Imm
-#endif
-
-#if powerpc_TARGET_ARCH
-  = AddrRegReg	Reg Reg
-  | AddrRegImm	Reg Imm
-#endif
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-addrModeRegs :: AddrMode -> [Reg]
-addrModeRegs (AddrBaseIndex b i _) =  b_regs ++ i_regs
-  where
-   b_regs = case b of { EABaseReg r -> [r]; _ -> [] }
-   i_regs = case i of { EAIndex r _ -> [r]; _ -> [] }
-addrModeRegs _ = []
-#endif
-
-
-addrOffset :: AddrMode -> Int -> Maybe AddrMode
-
-addrOffset addr off
-  = case addr of
-#if alpha_TARGET_ARCH
-      _ -> panic "MachMisc.addrOffset not defined for Alpha"
-#endif
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-      ImmAddr i off0	  -> Just (ImmAddr i (off0 + off))
-
-      AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))
-      AddrBaseIndex r i (ImmInteger n)
-	-> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))
-
-      AddrBaseIndex r i (ImmCLbl lbl)
-	-> Just (AddrBaseIndex r i (ImmIndex lbl off))
-
-      AddrBaseIndex r i (ImmIndex lbl ix)
-	-> Just (AddrBaseIndex r i (ImmIndex lbl (ix+off)))
-
-      _ -> Nothing  -- in theory, shouldn't happen
-#endif
-#if sparc_TARGET_ARCH
-      AddrRegImm r (ImmInt n)
-       | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2))
-       | otherwise     -> Nothing
-       where n2 = n + off
-
-      AddrRegImm r (ImmInteger n)
-       | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
-       | otherwise     -> Nothing
-       where n2 = n + toInteger off
-
-      AddrRegReg r (RealReg 0)
-       | fits13Bits off -> Just (AddrRegImm r (ImmInt off))
-       | otherwise     -> Nothing
-       
-      _ -> Nothing
-#endif /* sparc */
-#if powerpc_TARGET_ARCH
-      AddrRegImm r (ImmInt n)
-       | fits16Bits n2 -> Just (AddrRegImm r (ImmInt n2))
-       | otherwise     -> Nothing
-       where n2 = n + off
-
-      AddrRegImm r (ImmInteger n)
-       | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
-       | otherwise     -> Nothing
-       where n2 = n + toInteger off
-       
-      _ -> Nothing
-#endif /* powerpc */
-
------------------
-#if alpha_TARGET_ARCH
-
-fits8Bits :: Integer -> Bool
-fits8Bits i = i >= -256 && i < 256
-
-#endif
-
-#if sparc_TARGET_ARCH
-
-{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}
-fits13Bits :: Integral a => a -> Bool
-fits13Bits x = x >= -4096 && x < 4096
-
------------------
-largeOffsetError i
-  = error ("ERROR: SPARC native-code generator cannot handle large offset ("
-           ++show i++");\nprobably because of large constant data structures;" ++ 
-           "\nworkaround: use -fvia-C on this module.\n")
-
-#endif /* sparc */
-
-#if powerpc_TARGET_ARCH
-fits16Bits :: Integral a => a -> Bool
-fits16Bits x = x >= -32768 && x < 32768
-
-makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
-makeImmediate rep signed x = fmap ImmInt (toI16 rep signed)
-    where
-        narrow W32 False = fromIntegral (fromIntegral x :: Word32)
-        narrow W16 False = fromIntegral (fromIntegral x :: Word16)
-        narrow W8  False = fromIntegral (fromIntegral x :: Word8)
-        narrow W32 True  = fromIntegral (fromIntegral x :: Int32)
-        narrow W16 True  = fromIntegral (fromIntegral x :: Int16)
-        narrow W8  True  = fromIntegral (fromIntegral x :: Int8)
-        
-        narrowed = narrow rep signed
-        
-        toI16 W32 True
-            | narrowed >= -32768 && narrowed < 32768 = Just narrowed
-            | otherwise = Nothing
-        toI16 W32 False
-            | narrowed >= 0 && narrowed < 65536 = Just narrowed
-            | otherwise = Nothing
-        toI16 _ _  = Just narrowed
-#endif
-
-
--- @spRel@ gives us a stack relative addressing mode for volatile
--- temporaries and for excess call arguments.  @fpRel@, where
--- applicable, is the same but for the frame pointer.
-
-spRel :: Int	-- desired stack offset in words, positive or negative
-      -> AddrMode
-
-spRel n
-#if defined(i386_TARGET_ARCH)
-  = AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt (n * wORD_SIZE))
-#elif defined(x86_64_TARGET_ARCH)
-  = AddrBaseIndex (EABaseReg rsp) EAIndexNone (ImmInt (n * wORD_SIZE))
-#else
-  = AddrRegImm sp (ImmInt (n * wORD_SIZE))
-#endif
-
-#if sparc_TARGET_ARCH
-fpRel :: Int -> AddrMode
-    -- Duznae work for offsets greater than 13 bits; we just hope for
-    -- the best
-fpRel n
-  = AddrRegImm fp (ImmInt (n * wORD_SIZE))
-#endif
-
-#if x86_64_TARGET_ARCH
-ripRel imm = AddrBaseIndex EABaseRip EAIndexNone imm
-#endif
-
--- -----------------------------------------------------------------------------
--- 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)
-
--- ---------------------------------------------------------------------------
--- Registers
-
--- 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.
-
--- 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).  With the new register allocator, 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.
-
--- 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 (VirtualRegI u) 
-   = VirtualRegHi (newTagUnique u 'H') -- makes a pseudo-unique with tag 'H'
-getHiVRegFromLo other 
-   = pprPanic "getHiVRegFromLo" (ppr other)
-
-data RegClass 
-   = RcInteger 
-   | RcFloat
-   | RcDouble
-     deriving Eq
-
-instance Uniquable RegClass where
-    getUnique RcInteger	= mkUnique 'L' 0
-    getUnique RcFloat	= mkUnique 'L' 1
-    getUnique RcDouble	= mkUnique 'L' 2
-
-type RegNo = Int
-
-data Reg
-   = RealReg      {-# UNPACK #-} !RegNo
-   | VirtualRegI  {-# UNPACK #-} !Unique
-   | VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register
-   | VirtualRegF  {-# UNPACK #-} !Unique
-   | VirtualRegD  {-# UNPACK #-} !Unique
-   deriving (Eq,Ord)
-
--- We like to have Uniques for Reg so that we can make UniqFM and UniqSets 
--- in the register allocator.
-instance Uniquable Reg where
-   getUnique (RealReg i)      = mkUnique 'C' i
-   getUnique (VirtualRegI u)  = u
-   getUnique (VirtualRegHi u) = u
-   getUnique (VirtualRegF u)  = u
-   getUnique (VirtualRegD u)  = u
-
-unRealReg (RealReg i) = i
-unRealReg vreg        = pprPanic "unRealReg on VirtualReg" (ppr vreg)
-
-mkVReg :: Unique -> Size -> Reg
-mkVReg u size
-   | not (isFloatSize size) = VirtualRegI u
-   | otherwise
-   = case size of
-#if sparc_TARGET_ARCH
-        FF32    -> VirtualRegF u
-	FF64	-> VirtualRegD u
-#else
-        FF32    -> VirtualRegD u
-        FF64    -> VirtualRegD u
-#endif
-	_other -> panic "mkVReg"
-
-isVirtualReg :: Reg -> Bool
-isVirtualReg (RealReg _)      = False
-isVirtualReg (VirtualRegI _)  = True
-isVirtualReg (VirtualRegHi _) = True
-isVirtualReg (VirtualRegF _)  = True
-isVirtualReg (VirtualRegD _)  = True
-
-isRealReg :: Reg -> Bool
-isRealReg = not . isVirtualReg
-
-renameVirtualReg :: Unique -> Reg -> Reg
-renameVirtualReg u r
- = case r of
- 	RealReg _	-> error "renameVirtualReg: can't change unique on a real reg"
-	VirtualRegI _	-> VirtualRegI  u
-	VirtualRegHi _	-> VirtualRegHi u
-	VirtualRegF _	-> VirtualRegF  u
-	VirtualRegD _	-> VirtualRegD  u
-
-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 RegClass where
-    ppr RcInteger	= Outputable.text "I"
-    ppr RcFloat		= Outputable.text "F"
-    ppr RcDouble	= Outputable.text "D"
-
-instance Outputable Reg where
-    ppr r = Outputable.text (show r)
-
-
-
-
--- 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))
-
-#elif x86_64_TARGET_ARCH
-#define ALLOCATABLE_REGS_INTEGER (_ILIT(5))
-#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(2))
-
-#elif powerpc_TARGET_ARCH
-#define ALLOCATABLE_REGS_INTEGER (_ILIT(16))
-#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(26))
-
-#elif sparc_TARGET_ARCH
-#define ALLOCATABLE_REGS_INTEGER (_ILIT(3))
-#define ALLOCATABLE_REGS_DOUBLE  (_ILIT(6))
-
-#else
-#error ToDo: define ALLOCATABLE_REGS_INTEGER and ALLOCATABLE_REGS_DOUBLE
-#endif
-
-{-# INLINE regClass      #-}
-trivColorable :: RegClass -> UniqSet Reg -> UniqSet Reg -> Bool
-trivColorable classN 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' #)
-
-		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
-
-
-
--- -----------------------------------------------------------------------------
--- Machine-specific register stuff
-
--- 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.
-
-#if alpha_TARGET_ARCH
-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
-#endif
-
-{-
-Intel x86 architecture:
-- All registers except 7 (esp) are available for use.
-- Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
-- Registers 0-7 have 16-bit counterparts (ax, bx etc.)
-- Registers 0-3 have 8 bit counterparts (ah, bh etc.)
-- Registers 8-13 are fakes; we pretend x86 has 6 conventionally-addressable
-  fp registers, and 3-operand insns for them, and we translate this into
-  real stack-based x86 fp code after register allocation.
-
-The fp registers are all Double registers; we don't have any RcFloat class
-regs.  @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should
-never generate them.
--}
-
-#if i386_TARGET_ARCH
-
-fake0, fake1, fake2, fake3, fake4, fake5, 
-       eax, ebx, ecx, edx, esp, ebp, esi, edi :: Reg
-eax   = RealReg 0
-ebx   = RealReg 1
-ecx   = RealReg 2
-edx   = RealReg 3
-esi   = RealReg 4
-edi   = RealReg 5
-ebp   = RealReg 6
-esp   = RealReg 7
-fake0 = RealReg 8
-fake1 = RealReg 9
-fake2 = RealReg 10
-fake3 = RealReg 11
-fake4 = RealReg 12
-fake5 = RealReg 13
-
-
--- On x86, we might want to have an 8-bit RegClass, which would
--- contain just regs 1-4 (the others don't have 8-bit versions).
--- However, we can get away without this at the moment because the
--- only allocatable integer regs are also 8-bit compatible (1, 3, 4).
-regClass (RealReg i)     = if i < 8 then RcInteger else RcDouble
-regClass (VirtualRegI  u) = RcInteger
-regClass (VirtualRegHi u) = RcInteger
-regClass (VirtualRegD  u) = RcDouble
-regClass (VirtualRegF  u) = pprPanic "regClass(x86):VirtualRegF" 
-                                    (ppr (VirtualRegF u))
-
-regNames 
-   = ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp", 
-      "%fake0", "%fake1", "%fake2", "%fake3", "%fake4", "%fake5", "%fake6"]
-
-showReg :: RegNo -> String
-showReg n
-   = if   n >= 0 && n < 14
-     then regNames !! n
-     else "%unknown_x86_real_reg_" ++ show n
-
-
-#endif
-
-{-
-AMD x86_64 architecture:
-- Registers 0-16 have 32-bit counterparts (eax, ebx etc.)
-- Registers 0-7 have 16-bit counterparts (ax, bx etc.)
-- Registers 0-3 have 8 bit counterparts (ah, bh etc.)
-
--}
-
-#if x86_64_TARGET_ARCH
-
-rax, rbx, rcx, rdx, rsp, rbp, rsi, rdi, 
-  r8, r9, r10, r11, r12, r13, r14, r15,
-  xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,
-  xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15 :: Reg
-
-rax   = RealReg 0
-rbx   = RealReg 1
-rcx   = RealReg 2
-rdx   = RealReg 3
-rsi   = RealReg 4
-rdi   = RealReg 5
-rbp   = RealReg 6
-rsp   = RealReg 7
-r8    = RealReg 8
-r9    = RealReg 9
-r10   = RealReg 10
-r11   = RealReg 11
-r12   = RealReg 12
-r13   = RealReg 13
-r14   = RealReg 14
-r15   = RealReg 15
-xmm0  = RealReg 16
-xmm1  = RealReg 17
-xmm2  = RealReg 18
-xmm3  = RealReg 19
-xmm4  = RealReg 20
-xmm5  = RealReg 21
-xmm6  = RealReg 22
-xmm7  = RealReg 23
-xmm8  = RealReg 24
-xmm9  = RealReg 25
-xmm10 = RealReg 26
-xmm11 = RealReg 27
-xmm12 = RealReg 28
-xmm13 = RealReg 29
-xmm14 = RealReg 30
-xmm15 = RealReg 31
-
- -- so we can re-use some x86 code:
-eax = rax
-ebx = rbx
-ecx = rcx
-edx = rdx
-esi = rsi
-edi = rdi
-ebp = rbp
-esp = rsp
-
-xmm n = RealReg (16+n)
-
--- On x86, we might want to have an 8-bit RegClass, which would
--- contain just regs 1-4 (the others don't have 8-bit versions).
--- However, we can get away without this at the moment because the
--- only allocatable integer regs are also 8-bit compatible (1, 3, 4).
-regClass (RealReg i)     = if i < 16 then RcInteger else RcDouble
-regClass (VirtualRegI  u) = RcInteger
-regClass (VirtualRegHi u) = RcInteger
-regClass (VirtualRegD  u) = RcDouble
-regClass (VirtualRegF  u) = pprPanic "regClass(x86_64):VirtualRegF" 
-                                    (ppr (VirtualRegF u))
-
-regNames 
- = ["%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi", "%rbp", "%rsp" ]
-
-showReg :: RegNo -> String
-showReg n
-  | n >= 16 = "%xmm" ++ show (n-16)
-  | n >= 8  = "%r" ++ show n
-  | otherwise = regNames !! n
-
-#endif
-
-{-
-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
-fptools/ghc/includes/MachRegs.h for a description of what's going on
-here.
--}
-
-#if sparc_TARGET_ARCH
-
-gReg,lReg,iReg,oReg,fReg :: Int -> RegNo
-gReg x = x
-oReg x = (8 + x)
-lReg x = (16 + x)
-iReg x = (24 + x)
-fReg x = (32 + x)
-
-nCG_FirstFloatReg :: RegNo
-nCG_FirstFloatReg = unRealReg NCG_FirstFloatReg
-
-regClass (VirtualRegI  u) = RcInteger
-regClass (VirtualRegHi u) = RcInteger
-regClass (VirtualRegF  u) = RcFloat
-regClass (VirtualRegD  u) = RcDouble
-regClass (RealReg i) | i < 32                = RcInteger 
-                     | i < nCG_FirstFloatReg = RcDouble
-                     | otherwise             = RcFloat
-
-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          = "%unknown_sparc_real_reg_" ++ show n
-
-g0, g1, g2, fp, sp, o0, o1, f0, f1, f6, f8, f22, f26, f27 :: Reg
-
-f6  = RealReg (fReg 6)
-f8  = RealReg (fReg 8)
-f22 = RealReg (fReg 22)
-f26 = RealReg (fReg 26)
-f27 = RealReg (fReg 27)
-
-
--- g0 is useful for codegen; is always zero, and writes to it vanish.
-g0  = RealReg (gReg 0)
-g1  = RealReg (gReg 1)
-g2  = RealReg (gReg 2)
-
--- FP, SP, int and float return (from C) regs.
-fp  = RealReg (iReg 6)
-sp  = RealReg (oReg 6)
-o0  = RealReg (oReg 0)
-o1  = RealReg (oReg 1)
-f0  = RealReg (fReg 0)
-f1  = RealReg (fReg 1)
-
-#endif
-
-{-
-The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
-point registers.
--}
-
-#if powerpc_TARGET_ARCH
-fReg :: Int -> RegNo
-fReg x = (32 + x)
-
-regClass (VirtualRegI  u) = RcInteger
-regClass (VirtualRegHi u) = RcInteger
-regClass (VirtualRegF  u) = pprPanic "regClass(ppc):VirtualRegF" 
-                                    (ppr (VirtualRegF u))
-regClass (VirtualRegD u) = RcDouble
-regClass (RealReg i) | i < 32                = RcInteger 
-		     | otherwise	     = RcDouble
-
-showReg :: RegNo -> String
-showReg n
-    | n >= 0 && n <= 31	  = "%r" ++ show n
-    | n >= 32 && n <= 63  = "%f" ++ show (n - 32)
-    | otherwise           = "%unknown_powerpc_real_reg_" ++ show n
-
-sp = RealReg 1
-r3 = RealReg 3
-r4 = RealReg 4
-r27 = RealReg 27
-r28 = RealReg 28
-f1 = RealReg $ fReg 1
-f20 = RealReg $ fReg 20
-f21 = RealReg $ fReg 21
-#endif
-
-{-
-Redefine the literals used for machine-registers with non-numeric
-names in the header files.  Gag me with a spoon, eh?
--}
-
-#if alpha_TARGET_ARCH
-#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
-#endif
-#if i386_TARGET_ARCH
-#define eax 0
-#define ebx 1
-#define ecx 2
-#define edx 3
-#define esi 4
-#define edi 5
-#define ebp 6
-#define esp 7
-#define fake0 8
-#define fake1 9
-#define fake2 10
-#define fake3 11
-#define fake4 12
-#define fake5 13
-#endif
-
-#if x86_64_TARGET_ARCH
-#define rax   0
-#define rbx   1
-#define rcx   2
-#define rdx   3
-#define rsi   4
-#define rdi   5
-#define rbp   6
-#define rsp   7
-#define r8    8
-#define r9    9
-#define r10   10
-#define r11   11
-#define r12   12
-#define r13   13
-#define r14   14
-#define r15   15
-#define xmm0  16
-#define xmm1  17
-#define xmm2  18
-#define xmm3  19
-#define xmm4  20
-#define xmm5  21
-#define xmm6  22
-#define xmm7  23
-#define xmm8  24
-#define xmm9  25
-#define xmm10 26
-#define xmm11 27
-#define xmm12 28
-#define xmm13 29
-#define xmm14 30
-#define xmm15 31
-#endif
-
-#if sparc_TARGET_ARCH
-#define g0 0
-#define g1 1
-#define g2 2
-#define g3 3
-#define g4 4
-#define g5 5
-#define g6 6
-#define g7 7
-#define o0 8
-#define o1 9
-#define o2 10
-#define o3 11
-#define o4 12
-#define o5 13
-#define o6 14
-#define o7 15
-#define l0 16
-#define l1 17
-#define l2 18
-#define l3 19
-#define l4 20
-#define l5 21
-#define l6 22
-#define l7 23
-#define i0 24
-#define i1 25
-#define i2 26
-#define i3 27
-#define i4 28
-#define i5 29
-#define i6 30
-#define i7 31
-
-#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
-#endif
-
-#if powerpc_TARGET_ARCH
-#define r0 0
-#define r1 1
-#define r2 2
-#define r3 3
-#define r4 4
-#define r5 5
-#define r6 6
-#define r7 7
-#define r8 8
-#define r9 9
-#define r10 10
-#define r11 11
-#define r12 12
-#define r13 13
-#define r14 14
-#define r15 15
-#define r16 16
-#define r17 17
-#define r18 18
-#define r19 19
-#define r20 20
-#define r21 21
-#define r22 22
-#define r23 23
-#define r24 24
-#define r25 25
-#define r26 26
-#define r27 27
-#define r28 28
-#define r29 29
-#define r30 30
-#define r31 31
-
-#ifdef darwin_TARGET_OS
-#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
-#else
-#define fr0  32
-#define fr1  33
-#define fr2  34
-#define fr3  35
-#define fr4  36
-#define fr5  37
-#define fr6  38
-#define fr7  39
-#define fr8  40
-#define fr9  41
-#define fr10 42
-#define fr11 43
-#define fr12 44
-#define fr13 45
-#define fr14 46
-#define fr15 47
-#define fr16 48
-#define fr17 49
-#define fr18 50
-#define fr19 51
-#define fr20 52
-#define fr21 53
-#define fr22 54
-#define fr23 55
-#define fr24 56
-#define fr25 57
-#define fr26 58
-#define fr27 59
-#define fr28 60
-#define fr29 61
-#define fr30 62
-#define fr31 63
-#endif
-#endif
-
-
--- allMachRegs is the complete set of machine regs.
-allMachRegNos :: [RegNo]
-allMachRegNos
-   = IF_ARCH_alpha( [0..63],
-     IF_ARCH_i386(  [0..13],
-     IF_ARCH_x86_64( [0..31],
-     IF_ARCH_sparc( ([0..31]
-                     ++ [f0,f2 .. nCG_FirstFloatReg-1]
-                     ++ [nCG_FirstFloatReg .. f31]),
-     IF_ARCH_powerpc([0..63],
-                   )))))
-
--- 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
-
-allocatableRegsInteger	
-	= length $ filter (\r -> regClass r == RcInteger) 
-		 $ map RealReg allocatableRegs
-
-allocatableRegsDouble
-	= length $ filter (\r -> regClass r == RcDouble) 
-		 $ map RealReg allocatableRegs
-
-
--- these are the regs which we cannot assume stay alive over a
--- C call.  
-callClobberedRegs :: [Reg]
-callClobberedRegs
-  =
-#if alpha_TARGET_ARCH
-    [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]
-#endif /* alpha_TARGET_ARCH */
-#if i386_TARGET_ARCH
-    -- caller-saves registers
-    map RealReg [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5]
-#endif /* i386_TARGET_ARCH */
-#if x86_64_TARGET_ARCH
-    -- caller-saves registers
-    map RealReg ([rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11] ++ [16..31])
-       -- all xmm regs are caller-saves
-#endif /* x86_64_TARGET_ARCH */
-#if sparc_TARGET_ARCH
-    map RealReg 
-        ( oReg 7 :
-          [oReg i | i <- [0..5]] ++
-          [gReg i | i <- [1..7]] ++
-          [fReg i | i <- [0..31]] )
-#endif /* sparc_TARGET_ARCH */
-#if powerpc_TARGET_ARCH
-#if darwin_TARGET_OS
-    map RealReg (0:[2..12] ++ map fReg [0..13])
-#elif linux_TARGET_OS
-    map RealReg (0:[2..13] ++ map fReg [0..13])
-#endif
-#endif /* powerpc_TARGET_ARCH */
-
-
--- 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]
-
-#if i386_TARGET_ARCH
-argRegs _ = panic "MachRegs.argRegs(x86): should not be used!"
-#endif
-
-#if x86_64_TARGET_ARCH
-argRegs _ = panic "MachRegs.argRegs(x86_64): should not be used!"
-#endif
-
-#if alpha_TARGET_ARCH
-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!"
-#endif /* alpha_TARGET_ARCH */
-
-#if sparc_TARGET_ARCH
-argRegs 0 = []
-argRegs 1 = map (RealReg . oReg) [0]
-argRegs 2 = map (RealReg . oReg) [0,1]
-argRegs 3 = map (RealReg . oReg) [0,1,2]
-argRegs 4 = map (RealReg . oReg) [0,1,2,3]
-argRegs 5 = map (RealReg . oReg) [0,1,2,3,4]
-argRegs 6 = map (RealReg . oReg) [0,1,2,3,4,5]
-argRegs _ = panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
-#endif /* sparc_TARGET_ARCH */
-
-#if powerpc_TARGET_ARCH
-argRegs 0 = []
-argRegs 1 = map RealReg [3]
-argRegs 2 = map RealReg [3,4]
-argRegs 3 = map RealReg [3..5]
-argRegs 4 = map RealReg [3..6]
-argRegs 5 = map RealReg [3..7]
-argRegs 6 = map RealReg [3..8]
-argRegs 7 = map RealReg [3..9]
-argRegs 8 = map RealReg [3..10]
-argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"
-#endif /* powerpc_TARGET_ARCH */
-
-
--- all of the arg regs ??
-#if alpha_TARGET_ARCH
-allArgRegs :: [(Reg, Reg)]
-allArgRegs = [(realReg i, realReg (fReg i)) | i <- [16..21]]
-#endif /* alpha_TARGET_ARCH */
-
-#if sparc_TARGET_ARCH
-allArgRegs :: [Reg]
-allArgRegs = map RealReg [oReg i | i <- [0..5]]
-#endif /* sparc_TARGET_ARCH */
-
-#if i386_TARGET_ARCH
-allArgRegs :: [Reg]
-allArgRegs = panic "MachRegs.allArgRegs(x86): should not be used!"
-#endif
-
-#if x86_64_TARGET_ARCH
-allArgRegs :: [Reg]
-allArgRegs = map RealReg [rdi,rsi,rdx,rcx,r8,r9]
-allFPArgRegs :: [Reg]
-allFPArgRegs = map RealReg [xmm0 .. xmm7]
-#endif
-
-#if powerpc_TARGET_ARCH
-allArgRegs :: [Reg]
-allArgRegs = map RealReg [3..10]
-allFPArgRegs :: [Reg]
-#if darwin_TARGET_OS
-allFPArgRegs = map (RealReg . fReg) [1..13]
-#elif linux_TARGET_OS
-allFPArgRegs = map (RealReg . fReg) [1..8]
-#endif
-#endif /* powerpc_TARGET_ARCH */
-\end{code}
-
-\begin{code}
-freeReg :: RegNo -> FastBool
-
-#if alpha_TARGET_ARCH
-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)
-#endif
-
-#if i386_TARGET_ARCH
-freeReg esp = fastBool False  --	%esp is the C stack pointer
-#endif
-
-#if x86_64_TARGET_ARCH
-freeReg rsp = fastBool False  --	%rsp is the C stack pointer
-#endif
-
-#if sparc_TARGET_ARCH
-freeReg g0 = fastBool False  --	%g0 is always 0.
-
-freeReg g5 = fastBool False  --	%g5 is reserved (ABI).
-freeReg g6 = fastBool False  --	%g6 is reserved (ABI).
-freeReg g7 = fastBool False  --	%g7 is reserved (ABI).
-freeReg i6 = fastBool False  --	%i6 is our frame pointer.
-freeReg i7 = fastBool False  --	%i7 tends to have ret-addr-ish things
-freeReg o6 = fastBool False  --	%o6 is our stack pointer.
-freeReg o7 = fastBool False  --	%o7 holds ret addrs (???)
-freeReg f0 = fastBool False  --  %f0/%f1 are the C fp return registers.
-freeReg f1 = fastBool False
-
--- TODO: Not sure about these BL 2009/01/10
---	Used for NCG spill tmps? what is this?
-
-{-
-freeReg g1  = fastBool False  -- %g1 is used for NCG spill tmp
-freeReg g2  = fastBool False 
-freeReg f6  = fastBool False
-freeReg f8  = fastBool False
-freeReg f26 = fastBool False
-freeReg f27 = fastBool False
--}
-
-#endif
-
-#if powerpc_TARGET_ARCH
-freeReg 0 = fastBool False -- Hack: r0 can't be used in all insns, but it's actually free
-freeReg 1 = fastBool False -- The Stack Pointer
-#if !darwin_TARGET_OS
- -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that
-freeReg 2 = fastBool False
-#endif
-#endif
-
-#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
-
-
-\end{code}
diff --git a/compiler/nativeGen/PPC/Regs.hs b/compiler/nativeGen/PPC/Regs.hs
new file mode 100644
index 0000000000..d6993b210b
--- /dev/null
+++ b/compiler/nativeGen/PPC/Regs.hs
@@ -0,0 +1,584 @@
+-- -----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow 1994-2004
+-- 
+-- -----------------------------------------------------------------------------
+
+module PPC.Regs (
+	-- 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
+	allFPArgRegs,
+	fits16Bits,
+	makeImmediate,
+	fReg,
+	sp, r3, r4, r27, r28, f1, f20, f21,
+
+	-- horrow show
+	freeReg,
+	globalRegMaybe
+)
+
+where
+
+#include "nativeGen/NCG.h"
+#include "HsVersions.h"
+#include "../includes/MachRegs.h"
+
+import RegsBase
+
+import BlockId
+import Cmm
+import CLabel           ( CLabel )
+import Pretty
+import Outputable	( Outputable(..), pprPanic, panic )
+import qualified Outputable
+import Unique
+import Constants
+import FastBool
+
+import Data.Word	( Word8, Word16, Word32 )
+import Data.Int 	( Int8, Int16, Int32 )
+
+-- sizes -----------------------------------------------------------------------
+-- For these three, the "size" also gives the int/float
+-- distinction, because the instructions for int/float
+-- differ only in their suffices
+data Size	
+	= II8 | II16 | II32 | II64 | FF32 | FF64 | FF80
+	deriving Eq
+
+intSize, floatSize :: Width -> Size
+intSize W8 = II8
+intSize W16 = II16
+intSize W32 = II32
+intSize W64 = II64
+intSize other = pprPanic "MachInstrs.intSize" (ppr other)
+
+floatSize W32 = FF32
+floatSize W64 = FF64
+floatSize other = pprPanic "MachInstrs.intSize" (ppr other)
+
+
+isFloatSize :: Size -> Bool
+isFloatSize FF32 = True
+isFloatSize FF64 = True
+isFloatSize FF80 = True
+isFloatSize _    = False
+
+
+wordSize :: Size
+wordSize = intSize wordWidth
+
+
+cmmTypeSize :: CmmType -> Size
+cmmTypeSize ty 
+	| isFloatType ty	= floatSize (typeWidth ty)
+	| otherwise		= intSize (typeWidth ty)
+
+
+sizeToWidth :: Size -> Width
+sizeToWidth II8  = W8
+sizeToWidth II16 = W16
+sizeToWidth II32 = W32
+sizeToWidth II64 = W64
+sizeToWidth FF32 = W32
+sizeToWidth FF64 = W64
+sizeToWidth _ = panic "MachInstrs.sizeToWidth"
+
+
+mkVReg :: Unique -> Size -> Reg
+mkVReg u size
+   | not (isFloatSize size) = VirtualRegI u
+   | otherwise
+   = case size of
+        FF32	-> VirtualRegD u
+        FF64	-> VirtualRegD u
+	_	-> panic "mkVReg"
+
+
+
+-- immediates ------------------------------------------------------------------
+data Imm
+	= ImmInt	Int
+	| ImmInteger	Integer	    -- Sigh.
+	| ImmCLbl	CLabel	    -- AbstractC Label (with baggage)
+	| ImmLit	Doc	    -- Simple string
+	| ImmIndex    CLabel Int
+	| ImmFloat	Rational
+	| ImmDouble	Rational
+	| ImmConstantSum Imm Imm
+	| ImmConstantDiff Imm Imm
+	| LO Imm
+	| HI Imm
+	| HA Imm	{- high halfword adjusted -}
+
+
+strImmLit :: String -> Imm
+strImmLit s = ImmLit (text s)
+
+
+litToImm :: CmmLit -> Imm
+litToImm (CmmInt i w)        = ImmInteger (narrowS w i)
+                -- narrow to the width: a CmmInt might be out of
+                -- range, but we assume that ImmInteger only contains
+                -- in-range values.  A signed value should be fine here.
+litToImm (CmmFloat f W32)    = ImmFloat f
+litToImm (CmmFloat f W64)    = ImmDouble f
+litToImm (CmmLabel l)        = ImmCLbl l
+litToImm (CmmLabelOff l off) = ImmIndex l off
+litToImm (CmmLabelDiffOff l1 l2 off)
+                             = ImmConstantSum
+                               (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
+                               (ImmInt off)
+litToImm (CmmBlock id)       = ImmCLbl (infoTblLbl id)
+litToImm _                   = panic "PPC.Regs.litToImm: no match"
+
+
+-- addressing modes ------------------------------------------------------------
+
+data AddrMode
+	= AddrRegReg	Reg Reg
+	| AddrRegImm	Reg Imm
+
+
+addrOffset :: AddrMode -> Int -> Maybe AddrMode
+addrOffset addr off
+  = case addr of
+      AddrRegImm r (ImmInt n)
+       | fits16Bits n2 -> Just (AddrRegImm r (ImmInt n2))
+       | otherwise     -> Nothing
+       where n2 = n + off
+
+      AddrRegImm r (ImmInteger n)
+       | fits16Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
+       | otherwise     -> Nothing
+       where n2 = n + toInteger off
+       
+      _ -> Nothing
+
+
+-- registers -------------------------------------------------------------------
+-- @spRel@ gives us a stack relative addressing mode for volatile
+-- temporaries and for excess call arguments.  @fpRel@, where
+-- applicable, is the same but for the frame pointer.
+
+spRel :: Int	-- desired stack offset in words, positive or negative
+      -> AddrMode
+
+spRel n	= AddrRegImm sp (ImmInt (n * wORD_SIZE))
+
+
+-- 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 = map RealReg [3]
+argRegs 2 = map RealReg [3,4]
+argRegs 3 = map RealReg [3..5]
+argRegs 4 = map RealReg [3..6]
+argRegs 5 = map RealReg [3..7]
+argRegs 6 = map RealReg [3..8]
+argRegs 7 = map RealReg [3..9]
+argRegs 8 = map RealReg [3..10]
+argRegs _ = panic "MachRegs.argRegs(powerpc): don't know about >8 arguments!"
+
+
+allArgRegs :: [Reg]
+allArgRegs = map RealReg [3..10]
+
+
+-- these are the regs which we cannot assume stay alive over a C call.  
+callClobberedRegs :: [Reg]
+#if   defined(darwin_TARGET_OS)
+callClobberedRegs
+  = map RealReg (0:[2..12] ++ map fReg [0..13])
+
+#elif defined(linux_TARGET_OS)
+callClobberedRegs
+  = map RealReg (0:[2..13] ++ map fReg [0..13])
+
+#else
+callClobberedRegs
+	= panic "PPC.Regs.callClobberedRegs: not defined for this architecture"
+#endif
+
+
+allMachRegNos 	:: [RegNo]
+allMachRegNos	= [0..63]
+
+
+{-# INLINE regClass      #-}
+regClass :: Reg -> RegClass
+regClass (VirtualRegI  _) = RcInteger
+regClass (VirtualRegHi _) = RcInteger
+regClass (VirtualRegF  u) = pprPanic ("regClass(ppc):VirtualRegF ") (ppr u)
+regClass (VirtualRegD  _) = RcDouble
+regClass (RealReg i) 
+	| i < 32	= RcInteger 
+	| otherwise	= RcDouble
+
+
+showReg :: RegNo -> String
+showReg n
+    | n >= 0 && n <= 31	  = "%r" ++ show n
+    | n >= 32 && n <= 63  = "%f" ++ show (n - 32)
+    | otherwise           = "%unknown_powerpc_real_reg_" ++ show n
+
+
+
+-- machine specific ------------------------------------------------------------
+
+allFPArgRegs :: [Reg]
+#if    defined(darwin_TARGET_OS)
+allFPArgRegs = map (RealReg . fReg) [1..13]
+
+#elif  defined(linux_TARGET_OS)
+allFPArgRegs = map (RealReg . fReg) [1..8]
+
+#else
+allFPArgRegs = panic "PPC.Regs.allFPArgRegs: not defined for this architecture"
+
+#endif
+
+fits16Bits :: Integral a => a -> Bool
+fits16Bits x = x >= -32768 && x < 32768
+
+makeImmediate :: Integral a => Width -> Bool -> a -> Maybe Imm
+makeImmediate rep signed x = fmap ImmInt (toI16 rep signed)
+    where
+        narrow W32 False = fromIntegral (fromIntegral x :: Word32)
+        narrow W16 False = fromIntegral (fromIntegral x :: Word16)
+        narrow W8  False = fromIntegral (fromIntegral x :: Word8)
+        narrow W32 True  = fromIntegral (fromIntegral x :: Int32)
+        narrow W16 True  = fromIntegral (fromIntegral x :: Int16)
+        narrow W8  True  = fromIntegral (fromIntegral x :: Int8)
+	narrow _   _     = panic "PPC.Regs.narrow: no match"
+        
+        narrowed = narrow rep signed
+        
+        toI16 W32 True
+            | narrowed >= -32768 && narrowed < 32768 = Just narrowed
+            | otherwise = Nothing
+        toI16 W32 False
+            | narrowed >= 0 && narrowed < 65536 = Just narrowed
+            | otherwise = Nothing
+        toI16 _ _  = Just narrowed
+
+
+{-
+The PowerPC has 64 registers of interest; 32 integer registers and 32 floating
+point registers.
+-}
+
+fReg :: Int -> RegNo
+fReg x = (32 + x)
+
+sp, r3, r4, r27, r28, f1, f20, f21 :: Reg
+sp 	= RealReg 1
+r3 	= RealReg 3
+r4 	= RealReg 4
+r27 	= RealReg 27
+r28 	= RealReg 28
+f1 	= RealReg $ fReg 1
+f20 	= RealReg $ fReg 20
+f21 	= RealReg $ fReg 21
+
+
+
+-- horror show -----------------------------------------------------------------
+freeReg :: RegNo -> FastBool
+globalRegMaybe :: GlobalReg -> Maybe Reg
+
+
+#if powerpc_TARGET_ARCH
+#define r0 0
+#define r1 1
+#define r2 2
+#define r3 3
+#define r4 4
+#define r5 5
+#define r6 6
+#define r7 7
+#define r8 8
+#define r9 9
+#define r10 10
+#define r11 11
+#define r12 12
+#define r13 13
+#define r14 14
+#define r15 15
+#define r16 16
+#define r17 17
+#define r18 18
+#define r19 19
+#define r20 20
+#define r21 21
+#define r22 22
+#define r23 23
+#define r24 24
+#define r25 25
+#define r26 26
+#define r27 27
+#define r28 28
+#define r29 29
+#define r30 30
+#define r31 31
+
+#ifdef darwin_TARGET_OS
+#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
+#else
+#define fr0  32
+#define fr1  33
+#define fr2  34
+#define fr3  35
+#define fr4  36
+#define fr5  37
+#define fr6  38
+#define fr7  39
+#define fr8  40
+#define fr9  41
+#define fr10 42
+#define fr11 43
+#define fr12 44
+#define fr13 45
+#define fr14 46
+#define fr15 47
+#define fr16 48
+#define fr17 49
+#define fr18 50
+#define fr19 51
+#define fr20 52
+#define fr21 53
+#define fr22 54
+#define fr23 55
+#define fr24 56
+#define fr25 57
+#define fr26 58
+#define fr27 59
+#define fr28 60
+#define fr29 61
+#define fr30 62
+#define fr31 63
+#endif
+
+
+
+freeReg 0 = fastBool False -- Hack: r0 can't be used in all insns, but it's actually free
+freeReg 1 = fastBool False -- The Stack Pointer
+#if !darwin_TARGET_OS
+ -- most non-darwin powerpc OSes use r2 as a TOC pointer or something like that
+freeReg 2 = fastBool False
+#endif
+
+#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.
+
+
+#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
+
+
+#else  /* powerpc_TARGET_ARCH */
+
+freeReg _		= 0#
+globalRegMaybe _	= panic "PPC.Regs.globalRegMaybe: not defined"
+
+#endif /* powerpc_TARGET_ARCH */
diff --git a/compiler/nativeGen/RegsBase.hs b/compiler/nativeGen/RegsBase.hs
new file mode 100644
index 0000000000..00c87cb917
--- /dev/null
+++ b/compiler/nativeGen/RegsBase.hs
@@ -0,0 +1,105 @@
+
+module RegsBase (
+	RegNo,
+	Reg(..), 
+	isRealReg, 
+	unRealReg,
+	isVirtualReg, 
+	renameVirtualReg,
+
+        RegClass(..)
+)
+
+where
+
+import Outputable	( Outputable(..) )
+import qualified Outputable
+import Panic
+import Unique
+
+-- ---------------------------------------------------------------------------
+-- Registers
+
+-- 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.
+
+-- 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).  With the new register allocator, 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.
+
+type RegNo 
+	= Int
+
+data Reg
+	= RealReg      {-# UNPACK #-} !RegNo
+	| VirtualRegI  {-# UNPACK #-} !Unique
+	| VirtualRegHi {-# UNPACK #-} !Unique  -- High part of 2-word register
+	| VirtualRegF  {-# UNPACK #-} !Unique
+	| VirtualRegD  {-# UNPACK #-} !Unique
+	deriving (Eq, Ord)
+
+
+-- We like to have Uniques for Reg so that we can make UniqFM and UniqSets 
+-- in the register allocator.
+instance Uniquable Reg where
+	getUnique (RealReg i)      = mkUnique 'C' i
+	getUnique (VirtualRegI u)  = u
+	getUnique (VirtualRegHi u) = u
+	getUnique (VirtualRegF u)  = u
+	getUnique (VirtualRegD u)  = u
+
+
+isRealReg :: Reg -> Bool
+isRealReg = not . isVirtualReg
+
+-- | Take the RegNo from a real reg
+unRealReg :: Reg -> RegNo
+unRealReg (RealReg i)	= i
+unRealReg _		= panic "unRealReg on VirtualReg"
+
+isVirtualReg :: Reg -> Bool
+isVirtualReg (RealReg _)      = False
+isVirtualReg (VirtualRegI _)  = True
+isVirtualReg (VirtualRegHi _) = True
+isVirtualReg (VirtualRegF _)  = True
+isVirtualReg (VirtualRegD _)  = True
+
+
+renameVirtualReg :: Unique -> Reg -> Reg
+renameVirtualReg u r
+ = case r of
+ 	RealReg _	-> error "renameVirtualReg: can't change unique on a real reg"
+	VirtualRegI _	-> VirtualRegI  u
+	VirtualRegHi _	-> VirtualRegHi u
+	VirtualRegF _	-> VirtualRegF  u
+	VirtualRegD _	-> VirtualRegD  u
+
+
+-- RegClass --------------------------------------------------------------------
+data RegClass 
+   = RcInteger 
+   | RcFloat
+   | RcDouble
+     deriving Eq
+
+instance Uniquable RegClass where
+    getUnique RcInteger	= mkUnique 'L' 0
+    getUnique RcFloat	= mkUnique 'L' 1
+    getUnique RcDouble	= mkUnique 'L' 2
+
+instance Outputable RegClass where
+    ppr RcInteger	= Outputable.text "I"
+    ppr RcFloat		= Outputable.text "F"
+    ppr RcDouble	= Outputable.text "D"
+
+
+
diff --git a/compiler/nativeGen/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs
new file mode 100644
index 0000000000..6e88ea9ce5
--- /dev/null
+++ b/compiler/nativeGen/SPARC/Regs.hs
@@ -0,0 +1,572 @@
+-- -----------------------------------------------------------------------------
+--
+-- (c) The University of Glasgow 1994-2004
+-- 
+-- -----------------------------------------------------------------------------
+
+module SPARC.Regs (
+
+	-- sizes
+	Size(..),
+	intSize, 
+	floatSize, 
+	isFloatSize, 
+	wordSize,
+	cmmTypeSize,
+	sizeToWidth,
+	mkVReg,
+
+	-- immediate values
+	Imm(..),
+	strImmLit,
+	litToImm,
+
+	-- addressing modes
+	AddrMode(..),
+	addrOffset,
+
+	-- registers
+	spRel,
+	argRegs, 
+	allArgRegs, 
+	callClobberedRegs,
+	allMachRegNos,
+	regClass,
+	showReg,
+
+	-- machine specific info
+	fpRel,
+	fits13Bits, 
+	largeOffsetError,
+	gReg, iReg, lReg, oReg, fReg,
+	fp, sp, g0, g1, g2, o0, o1, f0, f6, f8, f26, f27,
+	nCG_FirstFloatReg,
+
+	-- horror show
+	freeReg,
+	globalRegMaybe
+)
+
+where
+
+#include "nativeGen/NCG.h"
+#include "HsVersions.h"
+#include "../includes/MachRegs.h"
+
+import RegsBase
+
+import BlockId
+import Cmm
+import CLabel           ( CLabel )
+import Pretty
+import Outputable	( Outputable(..), pprPanic, panic )
+import qualified Outputable
+import Unique
+import Constants
+import FastBool
+
+
+data Size
+	= II8     -- byte (signed)
+--	| II8u    -- byte (unsigned)
+	| II16    -- halfword (signed, 2 bytes)
+--	| II16u   -- halfword (unsigned, 2 bytes)
+	| II32    -- word (4 bytes)
+	| II64    -- word (8 bytes)
+	| FF32    -- IEEE single-precision floating pt
+	| FF64    -- IEEE single-precision floating pt
+	deriving Eq
+
+
+intSize, floatSize :: Width -> Size
+intSize W8  	= II8
+--intSize W16 = II16u
+intSize W16 	= II16
+intSize W32 	= II32
+intSize W64 	= II64
+intSize other	= pprPanic "MachInstrs.intSize" (ppr other)
+
+floatSize W32	= FF32
+floatSize W64	= FF64
+floatSize other	= pprPanic "MachInstrs.intSize" (ppr other)
+
+
+isFloatSize :: Size -> Bool
+isFloatSize FF32	= True
+isFloatSize FF64	= True
+isFloatSize _		= False
+
+
+wordSize :: Size
+wordSize = intSize wordWidth
+
+
+cmmTypeSize :: CmmType -> Size
+cmmTypeSize ty 
+	| isFloatType ty	= floatSize (typeWidth ty)
+	| otherwise		= intSize (typeWidth ty)
+
+
+sizeToWidth :: Size -> Width
+sizeToWidth size
+ = case size of
+ 	II8		-> W8
+--	II8u		-> W8
+	II16		-> W16
+--	II16u		-> W16
+	II32		-> W32
+	II64		-> W64
+	FF32		-> W32
+	FF64		-> W64
+
+
+mkVReg :: Unique -> Size -> Reg
+mkVReg u size
+	| not (isFloatSize size) 
+	= VirtualRegI u
+
+	| otherwise
+	= case size of
+		FF32    -> VirtualRegF u
+		FF64	-> VirtualRegD u
+		_ 	-> panic "mkVReg"
+
+
+-- immediates ------------------------------------------------------------------
+data Imm
+	= ImmInt	Int
+	| ImmInteger	Integer	    -- Sigh.
+	| ImmCLbl	CLabel	    -- AbstractC Label (with baggage)
+	| ImmLit	Doc	    -- Simple string
+	| ImmIndex    CLabel Int
+	| ImmFloat	Rational
+	| ImmDouble	Rational
+	| ImmConstantSum Imm Imm
+	| ImmConstantDiff Imm Imm
+	| LO Imm		    {- Possible restrictions... -}
+	| HI Imm
+
+
+strImmLit :: String -> Imm
+strImmLit s = ImmLit (text s)
+
+
+-- narrow to the width: a CmmInt might be out of
+-- range, but we assume that ImmInteger only contains
+-- in-range values.  A signed value should be fine here.
+litToImm :: CmmLit -> Imm
+litToImm (CmmInt i w)        = ImmInteger (narrowS w i)
+litToImm (CmmFloat f W32)    = ImmFloat f
+litToImm (CmmFloat f W64)    = ImmDouble f
+litToImm (CmmLabel l)        = ImmCLbl l
+litToImm (CmmLabelOff l off) = ImmIndex l off
+
+litToImm (CmmLabelDiffOff l1 l2 off)
+                             = ImmConstantSum
+                               (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
+                               (ImmInt off)
+litToImm (CmmBlock id)		= ImmCLbl (infoTblLbl id)
+litToImm _
+	= panic "SPARC.Regs.litToImm: no match"
+
+-- addressing modes ------------------------------------------------------------
+data AddrMode
+	= AddrRegReg	Reg Reg
+	| AddrRegImm	Reg Imm
+
+
+addrOffset :: AddrMode -> Int -> Maybe AddrMode
+addrOffset addr off
+  = case addr of
+      AddrRegImm r (ImmInt n)
+       | fits13Bits n2 -> Just (AddrRegImm r (ImmInt n2))
+       | otherwise     -> Nothing
+       where n2 = n + off
+
+      AddrRegImm r (ImmInteger n)
+       | fits13Bits n2 -> Just (AddrRegImm r (ImmInt (fromInteger n2)))
+       | otherwise     -> Nothing
+       where n2 = n + toInteger off
+
+      AddrRegReg r (RealReg 0)
+       | fits13Bits off -> Just (AddrRegImm r (ImmInt off))
+       | otherwise     -> Nothing
+       
+      _ -> Nothing
+
+
+
+-- registers -------------------------------------------------------------------
+
+-- @spRel@ gives us a stack relative addressing mode for volatile
+-- temporaries and for excess call arguments.  @fpRel@, where
+-- applicable, is the same but for the frame pointer.
+spRel :: Int	-- desired stack offset in words, positive or negative
+      -> AddrMode
+
+spRel n	= AddrRegImm sp (ImmInt (n * wORD_SIZE))
+
+
+argRegs :: RegNo -> [Reg]
+argRegs 0 = []
+argRegs 1 = map (RealReg . oReg) [0]
+argRegs 2 = map (RealReg . oReg) [0,1]
+argRegs 3 = map (RealReg . oReg) [0,1,2]
+argRegs 4 = map (RealReg . oReg) [0,1,2,3]
+argRegs 5 = map (RealReg . oReg) [0,1,2,3,4]
+argRegs 6 = map (RealReg . oReg) [0,1,2,3,4,5]
+argRegs _ = panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
+
+
+allArgRegs :: [Reg]
+allArgRegs = map RealReg [oReg i | i <- [0..5]]
+
+
+-- These are the regs which we cannot assume stay alive over a C call.  
+callClobberedRegs :: [Reg]
+callClobberedRegs
+	= map RealReg 
+	        ( oReg 7 :
+	          [oReg i | i <- [0..5]] ++
+	          [gReg i | i <- [1..7]] ++
+	          [fReg i | i <- [0..31]] )
+
+
+allMachRegNos :: [RegNo]
+allMachRegNos
+	= ([0..31]
+               ++ [32,34 .. nCG_FirstFloatReg-1]
+               ++ [nCG_FirstFloatReg .. 63])	
+
+
+-- | Get the class of a register.
+{-# INLINE regClass      #-}
+regClass :: Reg -> RegClass
+regClass (VirtualRegI  _)	= RcInteger
+regClass (VirtualRegHi _)	= RcInteger
+regClass (VirtualRegF  _)	= RcFloat
+regClass (VirtualRegD  _)	= RcDouble
+regClass (RealReg i) 
+	| i < 32		= RcInteger 
+	| i < nCG_FirstFloatReg	= RcDouble
+	| otherwise		= RcFloat
+
+
+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          = "%unknown_sparc_real_reg_" ++ show n
+
+
+-- machine specific ------------------------------------------------------------
+
+-- Duznae work for offsets greater than 13 bits; we just hope for the best
+fpRel :: Int -> AddrMode
+fpRel n
+  = AddrRegImm fp (ImmInt (n * wORD_SIZE))
+
+
+{-# SPECIALIZE fits13Bits :: Int -> Bool, Integer -> Bool #-}
+fits13Bits :: Integral a => a -> Bool
+fits13Bits x = x >= -4096 && x < 4096
+
+
+largeOffsetError :: Integral a => a -> b
+largeOffsetError i
+  = error ("ERROR: SPARC native-code generator cannot handle large offset ("
+           ++ show i ++ ");\nprobably because of large constant data structures;" ++ 
+           "\nworkaround: use -fvia-C on this module.\n")
+
+
+{-
+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
+fptools/ghc/includes/MachRegs.h for a description of what's going on
+here.
+-}
+
+
+gReg,lReg,iReg,oReg,fReg :: Int -> RegNo
+gReg x = x
+oReg x = (8 + x)
+lReg x = (16 + x)
+iReg x = (24 + x)
+fReg x = (32 + x)
+
+
+g0, g1, g2, fp, sp, o0, o1, f0, f6, f8, f22, f26, f27 :: Reg
+f6  = RealReg (fReg 6)
+f8  = RealReg (fReg 8)
+f22 = RealReg (fReg 22)
+f26 = RealReg (fReg 26)
+f27 = RealReg (fReg 27)
+
+
+-- g0 is useful for codegen; is always zero, and writes to it vanish.
+g0  = RealReg (gReg 0)
+g1  = RealReg (gReg 1)
+g2  = RealReg (gReg 2)
+
+
+-- FP, SP, int and float return (from C) regs.
+fp  = RealReg (iReg 6)
+sp  = RealReg (oReg 6)
+o0  = RealReg (oReg 0)
+o1  = RealReg (oReg 1)
+f0  = RealReg (fReg 0)
+
+
+nCG_FirstFloatReg :: RegNo
+nCG_FirstFloatReg = unRealReg NCG_FirstFloatReg
+
+
+-- horror show -----------------------------------------------------------------
+#if sparc_TARGET_ARCH
+#define g0 0
+#define g1 1
+#define g2 2
+#define g3 3
+#define g4 4
+#define g5 5
+#define g6 6
+#define g7 7
+#define o0 8
+#define o1 9
+#define o2 10
+#define o3 11
+#define o4 12
+#define o5 13
+#define o6 14
+#define o7 15
+#define l0 16
+#define l1 17
+#define l2 18
+#define l3 19
+#define l4 20
+#define l5 21
+#define l6 22
+#define l7 23
+#define i0 24
+#define i1 25
+#define i2 26
+#define i3 27
+#define i4 28
+#define i5 29
+#define i6 30
+#define i7 31
+
+#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
+#endif
+
+
+freeReg :: RegNo -> FastBool
+
+freeReg g0 = fastBool False  --	%g0 is always 0.
+
+freeReg g5 = fastBool False  --	%g5 is reserved (ABI).
+freeReg g6 = fastBool False  --	%g6 is reserved (ABI).
+freeReg g7 = fastBool False  --	%g7 is reserved (ABI).
+freeReg i6 = fastBool False  --	%i6 is our frame pointer.
+freeReg i7 = fastBool False  --	%i7 tends to have ret-addr-ish things
+freeReg o6 = fastBool False  --	%o6 is our stack pointer.
+freeReg o7 = fastBool False  --	%o7 holds ret addrs (???)
+freeReg f0 = fastBool False  --  %f0/%f1 are the C fp return registers.
+freeReg f1 = fastBool False
+
+-- TODO: Not sure about these BL 2009/01/10
+--	Used for NCG spill tmps? what is this?
+
+{-
+freeReg g1  = fastBool False  -- %g1 is used for NCG spill tmp
+freeReg g2  = fastBool False 
+freeReg f6  = fastBool False
+freeReg f8  = fastBool False
+freeReg f26 = fastBool False
+freeReg f27 = fastBool False
+-}
+
+#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 _         = 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
diff --git a/compiler/nativeGen/X86/Regs.hs b/compiler/nativeGen/X86/Regs.hs
new file mode 100644
index 0000000000..3432090ff7
--- /dev/null
+++ b/compiler/nativeGen/X86/Regs.hs
@@ -0,0 +1,694 @@
+module X86.Regs (
+
+	-- 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
+	EABase(..), EAIndex(..), addrModeRegs,
+
+#if i386_TARGET_ARCH
+	-- part of address mode. shared for both arches.
+	eax, ebx, ecx, edx, esi, edi, ebp, esp,
+	fake0, fake1, fake2, fake3, fake4, fake5,
+#endif
+#if x86_64_TARGET_ARCH
+	-- part of address mode. shared for both arches.
+	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,
+#endif
+
+	-- horror show
+	freeReg,
+	globalRegMaybe
+)
+
+where
+
+#include "nativeGen/NCG.h"
+#include "HsVersions.h"
+
+#if i386_TARGET_ARCH
+# define STOLEN_X86_REGS 4
+-- HACK: go for the max
+#endif
+
+#include "../includes/MachRegs.h"
+
+import RegsBase
+
+import BlockId
+import Cmm
+import CLabel           ( CLabel )
+import Pretty
+import Outputable	( Outputable(..), pprPanic, panic )
+import qualified Outputable
+import Unique
+import FastBool
+
+-- -----------------------------------------------------------------------------
+-- Sizes on this architecture
+-- 
+-- A Size is usually a combination of width and class
+
+-- It looks very like the old MachRep, but it's now of purely local
+-- significance, here in the native code generator.  You can change it
+-- without global consequences.
+--
+-- A major use is as an opcode qualifier; thus the opcode 
+--	mov.l a b
+-- might be encoded 
+-- 	MOV II32 a b
+-- where the Size field encodes the ".l" part.
+
+-- ToDo: it's not clear to me that we need separate signed-vs-unsigned sizes
+-- here.  I've removed them from the x86 version, we'll see what happens --SDM
+
+-- ToDo: quite a few occurrences of Size could usefully be replaced by Width
+
+data Size
+	= II8 | II16 | II32 | II64 | FF32 | FF64 | FF80
+	deriving Eq
+
+intSize, floatSize :: Width -> Size
+intSize W8 = II8
+intSize W16 = II16
+intSize W32 = II32
+intSize W64 = II64
+intSize other = pprPanic "MachInstrs.intSize" (ppr other)
+
+
+floatSize W32 = FF32
+floatSize W64 = FF64
+floatSize other = pprPanic "MachInstrs.intSize" (ppr other)
+
+
+isFloatSize :: Size -> Bool
+isFloatSize FF32 = True
+isFloatSize FF64 = True
+isFloatSize FF80 = True
+isFloatSize _    = False
+
+
+wordSize :: Size
+wordSize = intSize wordWidth
+
+
+cmmTypeSize :: CmmType -> Size
+cmmTypeSize ty | isFloatType ty = floatSize (typeWidth ty)
+	       | otherwise	= intSize (typeWidth ty)
+
+
+sizeToWidth :: Size -> Width
+sizeToWidth II8  = W8
+sizeToWidth II16 = W16
+sizeToWidth II32 = W32
+sizeToWidth II64 = W64
+sizeToWidth FF32 = W32
+sizeToWidth FF64 = W64
+sizeToWidth _ = panic "MachInstrs.sizeToWidth"
+
+
+mkVReg :: Unique -> Size -> Reg
+mkVReg u size
+   | not (isFloatSize size) = VirtualRegI u
+   | otherwise
+   = case size of
+        FF32	-> VirtualRegD u
+        FF64	-> VirtualRegD u
+	_	-> panic "mkVReg"
+
+
+-- -----------------------------------------------------------------------------
+-- Immediates
+
+data Imm
+  = ImmInt	Int
+  | ImmInteger	Integer	    -- Sigh.
+  | ImmCLbl	CLabel	    -- AbstractC Label (with baggage)
+  | ImmLit	Doc	    -- Simple string
+  | ImmIndex    CLabel Int
+  | ImmFloat	Rational
+  | ImmDouble	Rational
+  | ImmConstantSum Imm Imm
+  | ImmConstantDiff Imm Imm
+
+
+strImmLit :: String -> Imm
+strImmLit s = ImmLit (text s)
+
+
+litToImm :: CmmLit -> Imm
+litToImm (CmmInt i w)        = ImmInteger (narrowS w i)
+                -- narrow to the width: a CmmInt might be out of
+                -- range, but we assume that ImmInteger only contains
+                -- in-range values.  A signed value should be fine here.
+litToImm (CmmFloat f W32)    = ImmFloat f
+litToImm (CmmFloat f W64)    = ImmDouble f
+litToImm (CmmLabel l)        = ImmCLbl l
+litToImm (CmmLabelOff l off) = ImmIndex l off
+litToImm (CmmLabelDiffOff l1 l2 off)
+                             = ImmConstantSum
+                               (ImmConstantDiff (ImmCLbl l1) (ImmCLbl l2))
+                               (ImmInt off)
+litToImm (CmmBlock id)       = ImmCLbl (infoTblLbl id)
+litToImm _                   = panic "X86.Regs.litToImm: no match"
+
+-- addressing modes ------------------------------------------------------------
+
+data AddrMode
+	= AddrBaseIndex	EABase EAIndex Displacement
+	| ImmAddr Imm Int
+
+data EABase       = EABaseNone  | EABaseReg Reg | EABaseRip
+data EAIndex      = EAIndexNone | EAIndex Reg Int
+type Displacement = Imm
+
+
+addrOffset :: AddrMode -> Int -> Maybe AddrMode
+addrOffset addr off
+  = case addr of
+      ImmAddr i off0	  -> Just (ImmAddr i (off0 + off))
+
+      AddrBaseIndex r i (ImmInt n) -> Just (AddrBaseIndex r i (ImmInt (n + off)))
+      AddrBaseIndex r i (ImmInteger n)
+	-> Just (AddrBaseIndex r i (ImmInt (fromInteger (n + toInteger off))))
+
+      AddrBaseIndex r i (ImmCLbl lbl)
+	-> Just (AddrBaseIndex r i (ImmIndex lbl off))
+
+      AddrBaseIndex r i (ImmIndex lbl ix)
+	-> Just (AddrBaseIndex r i (ImmIndex lbl (ix+off)))
+
+      _ -> Nothing  -- in theory, shouldn't happen
+
+
+addrModeRegs :: AddrMode -> [Reg]
+addrModeRegs (AddrBaseIndex b i _) =  b_regs ++ i_regs
+  where
+   b_regs = case b of { EABaseReg r -> [r]; _ -> [] }
+   i_regs = case i of { EAIndex r _ -> [r]; _ -> [] }
+addrModeRegs _ = []
+
+
+-- registers -------------------------------------------------------------------
+
+-- @spRel@ gives us a stack relative addressing mode for volatile
+-- temporaries and for excess call arguments.  @fpRel@, where
+-- applicable, is the same but for the frame pointer.
+
+
+spRel :: Int		-- ^ desired stack offset in words, positive or negative
+      -> AddrMode
+
+#if   i386_TARGET_ARCH
+spRel n	= AddrBaseIndex (EABaseReg esp) EAIndexNone (ImmInt (n * wORD_SIZE))
+
+#elif x86_64_TARGET_ARCH
+spRel n	= AddrBaseIndex (EABaseReg rsp) EAIndexNone (ImmInt (n * wORD_SIZE))
+
+#else
+spRel _	= panic "X86.Regs.spRel: not defined for this architecture"
+
+#endif
+
+
+-- 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 _	= panic "MachRegs.argRegs(x86): should not be used!"
+
+
+
+-- 
+allArgRegs :: [Reg]
+
+#if   i386_TARGET_ARCH
+allArgRegs = panic "X86.Regs.allArgRegs: should not be used!"
+
+#elif x86_64_TARGET_ARCH
+allArgRegs = map RealReg [rdi,rsi,rdx,rcx,r8,r9]
+
+#else
+allArgRegs  = panic "X86.Regs.allArgRegs: not defined for this architecture"
+#endif
+
+
+-- | these are the regs which we cannot assume stay alive over a C call.  
+callClobberedRegs :: [Reg]
+
+#if   i386_TARGET_ARCH
+-- caller-saves registers
+callClobberedRegs
+  = map RealReg [eax,ecx,edx,fake0,fake1,fake2,fake3,fake4,fake5]
+
+#elif x86_64_TARGET_ARCH
+-- all xmm regs are caller-saves
+-- caller-saves registers
+callClobberedRegs    
+  = map RealReg ([rax,rcx,rdx,rsi,rdi,r8,r9,r10,r11] ++ [16..31])
+
+#else
+callClobberedRegs
+  = panic "X86.Regs.callClobberedRegs: not defined for this architecture"
+#endif
+
+
+-- | The complete set of machine registers.
+allMachRegNos :: [RegNo]
+
+#if   i386_TARGET_ARCH
+allMachRegNos	= [0..13]
+
+#elif x86_64_TARGET_ARCH
+allMachRegNos  = [0..31]
+
+#else
+allMachRegNos	= panic "X86.Regs.callClobberedRegs: not defined for this architecture"
+
+#endif
+
+
+-- | Take the class of a register.
+{-# INLINE regClass      #-}
+regClass :: Reg -> RegClass
+
+#if   i386_TARGET_ARCH
+-- On x86, we might want to have an 8-bit RegClass, which would
+-- contain just regs 1-4 (the others don't have 8-bit versions).
+-- However, we can get away without this at the moment because the
+-- only allocatable integer regs are also 8-bit compatible (1, 3, 4).
+regClass (RealReg i)     = if i < 8 then RcInteger else RcDouble
+regClass (VirtualRegI  u) = RcInteger
+regClass (VirtualRegHi u) = RcInteger
+regClass (VirtualRegD  u) = RcDouble
+regClass (VirtualRegF  u) = pprPanic "regClass(x86):VirtualRegF" 
+                                    (ppr (VirtualRegF u))
+
+#elif x86_64_TARGET_ARCH
+-- On x86, we might want to have an 8-bit RegClass, which would
+-- contain just regs 1-4 (the others don't have 8-bit versions).
+-- However, we can get away without this at the moment because the
+-- only allocatable integer regs are also 8-bit compatible (1, 3, 4).
+regClass (RealReg i)     = if i < 16 then RcInteger else RcDouble
+regClass (VirtualRegI  u) = RcInteger
+regClass (VirtualRegHi u) = RcInteger
+regClass (VirtualRegD  u) = RcDouble
+regClass (VirtualRegF  u) = pprPanic "regClass(x86_64):VirtualRegF" 
+                                    (ppr (VirtualRegF u))
+
+#else
+regClass _	= panic "X86.Regs.regClass: not defined for this architecture"
+
+#endif
+
+
+-- | Get the name of the register with this number.
+showReg :: RegNo -> String
+
+#if   i386_TARGET_ARCH
+showReg n
+   = if   n >= 0 && n < 14
+     then regNames !! n
+     else "%unknown_x86_real_reg_" ++ show n
+
+regNames 
+   = ["%eax", "%ebx", "%ecx", "%edx", "%esi", "%edi", "%ebp", "%esp", 
+      "%fake0", "%fake1", "%fake2", "%fake3", "%fake4", "%fake5", "%fake6"]
+
+#elif x86_64_TARGET_ARCH
+showReg n
+	| n >= 16	= "%xmm" ++ show (n-16)
+	| n >= 8	= "%r" ++ show n
+	| otherwise	= regNames !! n
+
+regNames 
+ = ["%rax", "%rbx", "%rcx", "%rdx", "%rsi", "%rdi", "%rbp", "%rsp" ]
+
+#else
+showReg _	= panic "X86.Regs.showReg: not defined for this architecture"
+
+#endif
+
+
+
+
+-- machine specific ------------------------------------------------------------
+
+
+{-
+Intel x86 architecture:
+- All registers except 7 (esp) are available for use.
+- Only ebx, esi, edi and esp are available across a C call (they are callee-saves).
+- Registers 0-7 have 16-bit counterparts (ax, bx etc.)
+- Registers 0-3 have 8 bit counterparts (ah, bh etc.)
+- Registers 8-13 are fakes; we pretend x86 has 6 conventionally-addressable
+  fp registers, and 3-operand insns for them, and we translate this into
+  real stack-based x86 fp code after register allocation.
+
+The fp registers are all Double registers; we don't have any RcFloat class
+regs.  @regClass@ barfs if you give it a VirtualRegF, and mkVReg above should
+never generate them.
+-}
+
+#if   i386_TARGET_ARCH
+fake0, fake1, fake2, fake3, fake4, fake5, 
+       eax, ebx, ecx, edx, esp, ebp, esi, edi :: Reg
+eax   = RealReg 0
+ebx   = RealReg 1
+ecx   = RealReg 2
+edx   = RealReg 3
+esi   = RealReg 4
+edi   = RealReg 5
+ebp   = RealReg 6
+esp   = RealReg 7
+fake0 = RealReg 8
+fake1 = RealReg 9
+fake2 = RealReg 10
+fake3 = RealReg 11
+fake4 = RealReg 12
+fake5 = RealReg 13
+
+#endif
+
+
+{-
+AMD x86_64 architecture:
+- Registers 0-16 have 32-bit counterparts (eax, ebx etc.)
+- Registers 0-7 have 16-bit counterparts (ax, bx etc.)
+- Registers 0-3 have 8 bit counterparts (ah, bh etc.)
+
+-}
+
+#if   x86_64_TARGET_ARCH
+allFPArgRegs :: [Reg]
+allFPArgRegs	= map RealReg [xmm0 .. xmm7]
+
+ripRel imm	= AddrBaseIndex EABaseRip EAIndexNone imm
+
+
+rax, rbx, rcx, rdx, rsp, rbp, rsi, rdi, 
+  r8, r9, r10, r11, r12, r13, r14, r15,
+  xmm0, xmm1, xmm2, xmm3, xmm4, xmm5, xmm6, xmm7,
+  xmm8, xmm9, xmm10, xmm11, xmm12, xmm13, xmm14, xmm15 :: Reg
+
+rax   = RealReg 0
+rbx   = RealReg 1
+rcx   = RealReg 2
+rdx   = RealReg 3
+rsi   = RealReg 4
+rdi   = RealReg 5
+rbp   = RealReg 6
+rsp   = RealReg 7
+r8    = RealReg 8
+r9    = RealReg 9
+r10   = RealReg 10
+r11   = RealReg 11
+r12   = RealReg 12
+r13   = RealReg 13
+r14   = RealReg 14
+r15   = RealReg 15
+xmm0  = RealReg 16
+xmm1  = RealReg 17
+xmm2  = RealReg 18
+xmm3  = RealReg 19
+xmm4  = RealReg 20
+xmm5  = RealReg 21
+xmm6  = RealReg 22
+xmm7  = RealReg 23
+xmm8  = RealReg 24
+xmm9  = RealReg 25
+xmm10 = RealReg 26
+xmm11 = RealReg 27
+xmm12 = RealReg 28
+xmm13 = RealReg 29
+xmm14 = RealReg 30
+xmm15 = RealReg 31
+
+ -- so we can re-use some x86 code:
+eax = rax
+ebx = rbx
+ecx = rcx
+edx = rdx
+esi = rsi
+edi = rdi
+ebp = rbp
+esp = rsp
+
+xmm n = RealReg (16+n)
+
+#endif
+
+
+
+-- horror show -----------------------------------------------------------------
+freeReg :: RegNo -> FastBool
+globalRegMaybe :: GlobalReg -> Maybe Reg
+
+#if defined(i386_TARGET_ARCH) || defined(x86_64_TARGET_ARCH)
+
+#if i386_TARGET_ARCH
+#define eax 0
+#define ebx 1
+#define ecx 2
+#define edx 3
+#define esi 4
+#define edi 5
+#define ebp 6
+#define esp 7
+#define fake0 8
+#define fake1 9
+#define fake2 10
+#define fake3 11
+#define fake4 12
+#define fake5 13
+#endif
+
+#if x86_64_TARGET_ARCH
+#define rax   0
+#define rbx   1
+#define rcx   2
+#define rdx   3
+#define rsi   4
+#define rdi   5
+#define rbp   6
+#define rsp   7
+#define r8    8
+#define r9    9
+#define r10   10
+#define r11   11
+#define r12   12
+#define r13   13
+#define r14   14
+#define r15   15
+#define xmm0  16
+#define xmm1  17
+#define xmm2  18
+#define xmm3  19
+#define xmm4  20
+#define xmm5  21
+#define xmm6  22
+#define xmm7  23
+#define xmm8  24
+#define xmm9  25
+#define xmm10 26
+#define xmm11 27
+#define xmm12 28
+#define xmm13 29
+#define xmm14 30
+#define xmm15 31
+#endif
+
+
+
+#if i386_TARGET_ARCH
+freeReg esp = fastBool False  --	%esp is the C stack pointer
+#endif
+
+#if x86_64_TARGET_ARCH
+freeReg rsp = fastBool False  --	%rsp is the C stack pointer
+#endif
+
+#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.
+
+#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
+
+#else /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
+
+freeReg	_		= 0#
+globalRegMaybe _	= panic "X86.Regs.globalRegMaybe: not defined"
+
+#endif