Split Reg into vreg/hreg and add register pairs

 * The old Reg type is now split into VirtualReg and RealReg.
 * For the graph coloring allocator, the type of the register graph
   is now (Graph VirtualReg RegClass RealReg), which shows that it colors
   in nodes representing virtual regs with colors representing real regs.
   (as was intended)  
 * RealReg contains two contructors, RealRegSingle and RealRegPair,
   where RealRegPair is used to represent a SPARC double reg 
   constructed from two single precision FP regs. 
 * On SPARC we can now allocate double regs into an arbitrary register
   pair, instead of reserving some reg ranges to only hold float/double values. 

1 files changed, 161 insertions, 0 deletions

diff --git a/compiler/nativeGen/SPARC/CodeGen/Expand.hs b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
new file mode 100644
index 0000000000..2becccb30d
--- /dev/null
+++ b/compiler/nativeGen/SPARC/CodeGen/Expand.hs
@@ -0,0 +1,161 @@
+
+-- | Expand out synthetic instructions into single machine instrs.
+module SPARC.CodeGen.Expand (
+	expandTop
+)
+
+where
+
+import SPARC.Instr
+import SPARC.Imm
+import SPARC.AddrMode
+import SPARC.Regs
+import SPARC.Ppr	()
+import Instruction
+import Reg
+import Size
+import Cmm
+
+
+import Outputable
+import OrdList
+
+-- | Expand out synthetic instructions in this top level thing
+expandTop :: NatCmmTop Instr -> NatCmmTop Instr
+expandTop top@(CmmData{})
+	= top
+
+expandTop (CmmProc info lbl params (ListGraph blocks))
+	= CmmProc info lbl params (ListGraph $ map expandBlock blocks)
+
+
+-- | Expand out synthetic instructions in this block
+expandBlock :: NatBasicBlock Instr -> NatBasicBlock Instr
+
+expandBlock (BasicBlock label instrs)
+ = let	instrs_ol	= expandBlockInstrs instrs
+ 	instrs'		= fromOL instrs_ol
+   in	BasicBlock label instrs'
+
+
+-- | Expand out some instructions
+expandBlockInstrs :: [Instr] -> OrdList Instr
+expandBlockInstrs []	= nilOL
+	
+expandBlockInstrs (ii:is)
+ = let	ii_doubleRegs	= remapRegPair ii
+	is_misaligned	= expandMisalignedDoubles ii_doubleRegs
+
+   in	is_misaligned `appOL` expandBlockInstrs is
+   
+
+
+-- | In the SPARC instruction set the FP register pairs that are used
+--	to hold 64 bit floats are refered to by just the first reg 
+--	of the pair. Remap our internal reg pairs to the appropriate reg.
+--
+--	For example:
+--	    ldd [%l1], (%f0 | %f1)
+--
+--	gets mapped to
+--	    ldd [$l1], %f0
+--
+remapRegPair :: Instr -> Instr
+remapRegPair instr
+ = let	patchF reg
+ 	 = case reg of
+	 	RegReal (RealRegSingle _) 	
+			-> reg
+
+		RegReal (RealRegPair r1 r2)	
+
+			-- sanity checking
+		 	| r1 	     >= 32
+			, r1 	     <= 63
+			, r1 `mod` 2 == 0	
+			, r2         == r1 + 1	
+			-> RegReal (RealRegSingle r1)
+
+			| otherwise		
+			-> pprPanic "SPARC.CodeGen.Expand: not remapping dodgy looking reg pair " (ppr reg)
+
+		RegVirtual _
+			-> pprPanic "SPARC.CodeGen.Expand: not remapping virtual reg " (ppr reg)
+			
+   in	patchRegsOfInstr instr patchF
+
+
+
+
+-- Expand out 64 bit load/stores into individual instructions to handle
+--	possible double alignment problems.
+--
+--	TODO: 	It'd be better to use a scratch reg instead of the add/sub thing.
+--		We might be able to do this faster if we use the UA2007 instr set
+--		instead of restricting ourselves to SPARC V9.
+--
+expandMisalignedDoubles :: Instr -> OrdList Instr
+expandMisalignedDoubles instr
+
+	-- Translate to:
+	--    add g1,g2,g1
+	--    ld  [g1],%fn
+	--    ld  [g1+4],%f(n+1)
+	--    sub g1,g2,g1           -- to restore g1
+ 	| LD FF64 (AddrRegReg r1 r2) fReg	<- instr
+	= 	toOL	[ ADD False False r1 (RIReg r2) r1
+			, LD  FF32  (AddrRegReg r1 g0) 		fReg
+			, LD  FF32  (AddrRegImm r1 (ImmInt 4))	(fRegHi fReg)
+			, SUB False False r1 (RIReg r2) r1 ]
+
+	-- Translate to
+	--    ld  [addr],%fn
+	--    ld  [addr+4],%f(n+1)
+	| LD FF64 addr fReg			<- instr
+	= let	Just addr'	= addrOffset addr 4
+	  in	toOL	[ LD  FF32  addr	fReg
+	  		, LD  FF32  addr'	(fRegHi fReg) ]
+
+	-- Translate to:
+	--    add g1,g2,g1
+	--    st  %fn,[g1]
+	--    st  %f(n+1),[g1+4]
+	--    sub g1,g2,g1           -- to restore g1
+	| ST FF64 fReg (AddrRegReg r1 r2)	<- instr
+	= 	toOL	[ ADD False False r1 (RIReg r2) r1
+			, ST  FF32  fReg           (AddrRegReg r1 g0) 		
+			, ST  FF32  (fRegHi fReg)  (AddrRegImm r1 (ImmInt 4))	
+			, SUB False False r1 (RIReg r2) r1 ]
+
+	-- Translate to
+	--    ld  [addr],%fn
+	--    ld  [addr+4],%f(n+1)
+	| ST FF64 fReg addr			<- instr
+	= let	Just addr'	= addrOffset addr 4
+	  in	toOL	[ ST  FF32  fReg           addr	
+	  		, ST  FF32  (fRegHi fReg)  addr'	 ]
+
+	-- some other instr
+	| otherwise
+	= unitOL instr
+
+
+
+-- | The the high partner for this float reg.	
+fRegHi :: Reg -> Reg
+fRegHi (RegReal (RealRegSingle r1))
+	| r1		>= 32
+	, r1		<= 63
+	, r1 `mod` 2 == 0
+	= (RegReal $ RealRegSingle (r1 + 1))
+	
+-- Can't take high partner for non-low reg.
+fRegHi reg
+	= pprPanic "SPARC.CodeGen.Expand: can't take fRegHi from " (ppr reg)
+	
+	
+	
+	
+	
+
+