SPARC NCG: Base freeRegs on includes/MachRegs.h again

5 files changed, 387 insertions, 84 deletions

diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 483303d84f..b37165805a 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -481,6 +481,7 @@ Library
             PPC.CodeGen
             SPARC.Base
             SPARC.Regs
+            SPARC.RegPlate
             SPARC.Imm
             SPARC.AddrMode	    
             SPARC.Cond
diff --git a/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs b/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
index 2b624c76f3..ac16d8a640 100644
--- a/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
+++ b/compiler/nativeGen/RegAlloc/Linear/SPARC/FreeRegs.hs
@@ -4,6 +4,7 @@ module RegAlloc.Linear.SPARC.FreeRegs
 where
 
 import SPARC.Regs
+import SPARC.RegPlate
 import RegClass
 import Reg
 
diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 30067825fa..25a723ea9e 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -29,6 +29,7 @@ import SPARC.Imm
 import SPARC.AddrMode
 import SPARC.Cond
 import SPARC.Regs
+import SPARC.RegPlate
 import SPARC.Base
 import Instruction
 import RegClass
diff --git a/compiler/nativeGen/SPARC/RegPlate.hs b/compiler/nativeGen/SPARC/RegPlate.hs
new file mode 100644
index 0000000000..38852c507c
--- /dev/null
+++ b/compiler/nativeGen/SPARC/RegPlate.hs
@@ -0,0 +1,287 @@
+
+-- | Nasty #ifdefery that generates the definitions for
+--	freeReg and globalRegMaybe from the information in includes/MachRegs.h.
+--	
+--	If the current TARGET_ARCH isn't sparc then these functions will be wrong.
+--
+module SPARC.RegPlate (
+	freeReg,
+	globalRegMaybe
+)
+
+where
+
+import Reg
+import CmmExpr
+import FastBool
+
+-- Register numbers for SPARC hardware registers.
+--	These names are the same as the ones in Regs.hs, but those have
+--	type Reg and not RegNo.
+--
+
+#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
+
+
+#include "../includes/MachRegs.h"
+
+-- | Check whether a machine register is free for allocation.
+freeReg :: RegNo -> FastBool
+
+
+#ifdef sparc_REGS
+-- SPARC regs used by the OS / ABI
+-- %g0(r0) is always zero
+freeReg g0	= fastBool False
+
+-- %g5(r5) - %g7(r7) 
+--	are reserved for the OS
+freeReg g5	= fastBool False
+freeReg g6	= fastBool False
+freeReg g7	= fastBool False
+
+-- %o6(r14) 
+--	is the C stack pointer
+freeReg	o6	= fastBool False
+
+-- %o7(r15) 
+--	holds the C return address
+freeReg	o7	= fastBool False
+
+-- %i6(r30) 
+--	is the C frame pointer
+freeReg	i6	= fastBool False
+
+-- %i7(r31) 
+--	is used for C return addresses
+freeReg	i7	= fastBool False
+
+-- %f0(r32) - %f1(r32)
+--	are C floating point return regs
+freeReg f0	= fastBool False
+freeReg f1	= fastBool False
+	
+freeReg regNo
+	-- don't release high half of double regs
+	| regNo >= f0
+	, regNo <  NCG_FirstFloatReg
+	, regNo `mod` 2 /= 0
+	= 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 _	= 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/SPARC/Regs.hs b/compiler/nativeGen/SPARC/Regs.hs
index b129d448e8..630d5a67c6 100644
--- a/compiler/nativeGen/SPARC/Regs.hs
+++ b/compiler/nativeGen/SPARC/Regs.hs
@@ -17,9 +17,7 @@ module SPARC.Regs (
 	fPair,
 
 	-- allocatable
-	freeReg,
 	allocatableRegs,
-	globalRegMaybe,
 	get_GlobalReg_reg_or_addr,
 
 	-- args
@@ -35,11 +33,13 @@ module SPARC.Regs (
 where
 
 
+import SPARC.RegPlate
 import Reg
 import RegClass
 import Size
 
 import Cmm
+import PprCmm
 import CgUtils          ( get_GlobalReg_addr )
 
 import Unique
@@ -142,15 +142,105 @@ fPair (RealReg n)
 fPair (VirtualRegD u)
 	= Just (VirtualRegHi u)
 
-fPair _
-	= trace ("MachInstrs.fPair: can't get high half of supposed double reg ") 
+fPair reg
+	= trace ("MachInstrs.fPair: can't get high half of supposed double reg " ++ showPpr reg)
 		Nothing
 
 
+
+-- 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
+
+
+
+-- 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)
+
+
+-- | The registers to place arguments for function calls, 
+--	for some number of arguments.
+--
+argRegs :: RegNo -> [Reg]
+argRegs r
+ = case r of
+ 	0	-> []
+	1	-> map (RealReg . oReg) [0]
+	2	-> map (RealReg . oReg) [0,1]
+	3	-> map (RealReg . oReg) [0,1,2]
+	4	-> map (RealReg . oReg) [0,1,2,3]
+	5	-> map (RealReg . oReg) [0,1,2,3,4]
+	6	-> map (RealReg . oReg) [0,1,2,3,4,5]
+	_	-> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
+
+
+-- | All all the regs that could possibly be returned by argRegs
+--
+allArgRegs :: [Reg]
+allArgRegs 
+	= map RealReg [oReg i | i <- [0..5]]
+
+
+-- These are the regs that we cannot assume stay alive over a C call.  
+--	TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
+--
+callClobberedRegs :: [Reg]
+callClobberedRegs
+	= map RealReg 
+	        (  oReg 7 :
+	          [oReg i | i <- [0..5]] ++
+	          [gReg i | i <- [1..7]] ++
+	          [fReg i | i <- [0..31]] )
+
+
+
+-- | Make a virtual reg with this size.
+mkVReg :: Unique -> Size -> Reg
+mkVReg u size
+	| not (isFloatSize size) 
+	= VirtualRegI u
+
+	| otherwise
+	= case size of
+		FF32    -> VirtualRegF u
+		FF64	-> VirtualRegD u
+		_ 	-> panic "mkVReg"
+
+
+regDotColor :: Reg -> SDoc
+regDotColor reg
+ = case regClass reg of
+ 	RcInteger	-> text "blue"
+	RcFloat		-> text "red"
+	RcDouble	-> text "green"
+
+
+
+
+
+-- Hard coded freeReg / globalRegMaybe -----------------------------------------
+-- This isn't being used at the moment because we're generating
+--	these functions from the information in includes/MachRegs.hs via RegPlate.hs
+	
 -- | Check whether a machine register is free for allocation.
 --	This needs to match the info in includes/MachRegs.h otherwise modules
 --	compiled with the NCG won't be compatible with via-C ones.
 --
+{-
 freeReg :: RegNo -> FastBool
 freeReg regno
  = case regno of
@@ -228,20 +318,13 @@ freeReg regno
 	-- regs not matched above are allocable.
 	_	-> fastBool True
 
-
--- 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
-
+-}
 
 -- | Returns Just the real register that a global register is stored in.
 --	Returns Nothing if the global has no real register, and is stored
 --	in the in-memory register table instead.
 --
+{-
 globalRegMaybe  :: GlobalReg -> Maybe Reg
 globalRegMaybe gg
  = case gg of
@@ -269,74 +352,4 @@ globalRegMaybe gg
 	BaseReg		-> Just (RealReg 25)	-- %i1
 		
 	_		-> Nothing 	
-
-
--- 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)
-
-
--- | The registers to place arguments for function calls, 
---	for some number of arguments.
---
-argRegs :: RegNo -> [Reg]
-argRegs r
- = case r of
- 	0	-> []
-	1	-> map (RealReg . oReg) [0]
-	2	-> map (RealReg . oReg) [0,1]
-	3	-> map (RealReg . oReg) [0,1,2]
-	4	-> map (RealReg . oReg) [0,1,2,3]
-	5	-> map (RealReg . oReg) [0,1,2,3,4]
-	6	-> map (RealReg . oReg) [0,1,2,3,4,5]
-	_	-> panic "MachRegs.argRegs(sparc): don't know about >6 arguments!"
-
-
--- | All all the regs that could possibly be returned by argRegs
---
-allArgRegs :: [Reg]
-allArgRegs 
-	= map RealReg [oReg i | i <- [0..5]]
-
-
--- These are the regs that we cannot assume stay alive over a C call.  
---	TODO: Why can we assume that o6 isn't clobbered? -- BL 2009/02
---
-callClobberedRegs :: [Reg]
-callClobberedRegs
-	= map RealReg 
-	        (  oReg 7 :
-	          [oReg i | i <- [0..5]] ++
-	          [gReg i | i <- [1..7]] ++
-	          [fReg i | i <- [0..31]] )
-
-
-
--- | Make a virtual reg with this size.
-mkVReg :: Unique -> Size -> Reg
-mkVReg u size
-	| not (isFloatSize size) 
-	= VirtualRegI u
-
-	| otherwise
-	= case size of
-		FF32    -> VirtualRegF u
-		FF64	-> VirtualRegD u
-		_ 	-> panic "mkVReg"
-
-
-regDotColor :: Reg -> SDoc
-regDotColor reg
- = case regClass reg of
- 	RcInteger	-> text "blue"
-	RcFloat		-> text "red"
-	RcDouble	-> text "green"
+-}