X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FSPARC%2FInstr.hs;h=00b57f9b06617aa3cb61d8d5e31b7f20857fb063;hb=49a8e5c021009430d373d6224b29004c7d18c408;hp=6c7af5b169d75f1a50d931fc3c653c29247f224b;hpb=547bf6827f1fc3f2fb31bc6323cc0d33b445f32a;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 6c7af5b..00b57f9 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -16,6 +16,8 @@ module SPARC.Instr (
 	fpRelEA,
 	moveSp,
 	
+	isUnconditionalJump,
+	
 	Instr(..),
 	maxSpillSlots
 )
@@ -27,7 +29,9 @@ import SPARC.Imm
 import SPARC.AddrMode
 import SPARC.Cond
 import SPARC.Regs
+import SPARC.RegPlate
 import SPARC.Base
+import TargetReg
 import Instruction
 import RegClass
 import Reg
@@ -37,8 +41,7 @@ import BlockId
 import Cmm
 import FastString
 import FastBool
-
-import GHC.Exts
+import Outputable
 
 
 -- | Register or immediate
@@ -50,11 +53,11 @@ data RI
 --  	- a literal zero
 --	- register %g0, which is always zero.
 --
-riZero :: RI -> Bool
-riZero (RIImm (ImmInt 0))	    = True
-riZero (RIImm (ImmInteger 0))	    = True
-riZero (RIReg (RealReg 0))          = True
-riZero _			    = False
+riZero :: RI -> Bool	
+riZero (RIImm (ImmInt 0))			= True
+riZero (RIImm (ImmInteger 0))			= True
+riZero (RIReg (RegReal (RealRegSingle 0)))	= True
+riZero _					= False
 
 
 -- | Calculate the effective address which would be used by the
@@ -69,6 +72,17 @@ moveSp :: Int -> Instr
 moveSp n
    = ADD False False sp (RIImm (ImmInt (n * wordLength))) sp
 
+-- | An instruction that will cause the one after it never to be exectuted
+isUnconditionalJump :: Instr -> Bool
+isUnconditionalJump ii
+ = case ii of
+ 	CALL{}		-> True
+	JMP{}		-> True
+	JMP_TBL{}	-> True
+	BI ALWAYS _ _	-> True
+	BF ALWAYS _ _ 	-> True
+	_		-> False
+
 
 -- | instance for sparc instruction set
 instance Instruction Instr where
@@ -113,6 +127,11 @@ data Instr
 	| ST		Size Reg AddrMode 		-- size, src, dst
 
 	-- Int Arithmetic.
+	--	x:   add/sub with carry bit. 
+	--		In SPARC V9 addx and friends were renamed addc. 
+	--
+	--	cc:  modify condition codes
+	-- 
 	| ADD		Bool Bool Reg RI Reg 		-- x?, cc?, src1, src2, dst
 	| SUB		Bool Bool Reg RI Reg 		-- x?, cc?, src1, src2, dst
 
@@ -252,11 +271,9 @@ sparc_regUsageOfInstr instr
 interesting :: Reg -> Bool
 interesting reg
  = case reg of
- 	VirtualRegI  _	-> True
-	VirtualRegHi _	-> True
-	VirtualRegF  _	-> True
-	VirtualRegD  _	-> True
-	RealReg i	-> isFastTrue (freeReg i)
+	RegVirtual _			-> True
+	RegReal (RealRegSingle r1)	-> isFastTrue (freeReg r1)
+	RegReal (RealRegPair r1 _)	-> isFastTrue (freeReg r1)
 
 
 
@@ -352,17 +369,18 @@ sparc_mkSpillInstr
 sparc_mkSpillInstr reg _ slot
  = let	off     = spillSlotToOffset slot
         off_w	= 1 + (off `div` 4)
-        sz 	= case regClass reg of
+        sz 	= case targetClassOfReg reg of
 			RcInteger -> II32
 			RcFloat   -> FF32
 			RcDouble  -> FF64
+			_         -> panic "sparc_mkSpillInstr"
 		
     in ST sz reg (fpRel (negate off_w))
 
 
 -- | Make a spill reload instruction.
 sparc_mkLoadInstr
-	:: Reg		-- ^ register to load
+	:: Reg		-- ^ register to load into
 	-> Int		-- ^ current stack delta
 	-> Int		-- ^ spill slot to use
 	-> Instr
@@ -370,10 +388,11 @@ sparc_mkLoadInstr
 sparc_mkLoadInstr reg _ slot
   = let off     = spillSlotToOffset slot
 	off_w	= 1 + (off `div` 4)
-        sz	= case regClass reg of
+        sz	= case targetClassOfReg reg of
 			RcInteger -> II32
 			RcFloat   -> FF32
 			RcDouble  -> FF64
+			_         -> panic "sparc_mkLoadInstr"
 
         in LD sz (fpRel (- off_w)) reg
 
@@ -414,10 +433,17 @@ sparc_mkRegRegMoveInstr
 	-> Instr
 
 sparc_mkRegRegMoveInstr src dst
- = case regClass src of
-	RcInteger -> ADD  False False src (RIReg g0) dst
-	RcDouble  -> FMOV FF64 src dst
-	RcFloat   -> FMOV FF32 src dst
+	| srcClass	<- targetClassOfReg src
+	, dstClass	<- targetClassOfReg dst
+	, srcClass == dstClass
+	= case srcClass of
+		RcInteger -> ADD  False False src (RIReg g0) dst
+		RcDouble  -> FMOV FF64 src dst
+		RcFloat   -> FMOV FF32 src dst
+                _         -> panic "sparc_mkRegRegMoveInstr"
+	
+	| otherwise
+	= panic "SPARC.Instr.mkRegRegMoveInstr: classes of src and dest not the same"
 
 
 -- | Check whether an instruction represents a reg-reg move.