X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FSPARC%2FInstr.hs;h=93f4d274449863580de3c6997f82577caca99f1e;hb=HEAD;hp=30067825fab78f4453dc6fc346372b16c5717e36;hpb=0bff9925654d75ef0fd8fb5d48b700337ebd8f47;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/SPARC/Instr.hs b/compiler/nativeGen/SPARC/Instr.hs
index 3006782..93f4d27 100644
--- a/compiler/nativeGen/SPARC/Instr.hs
+++ b/compiler/nativeGen/SPARC/Instr.hs
@@ -29,18 +29,20 @@ 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
 import Size
 
+import CLabel
 import BlockId
-import Cmm
+import OldCmm
 import FastString
 import FastBool
-
-import GHC.Exts
+import Outputable
 
 
 -- | Register or immediate
@@ -52,11 +54,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
@@ -193,7 +195,7 @@ data Instr
 	-- With a tabled jump we know all the possible destinations.
 	-- We also need this info so we can work out what regs are live across the jump.
 	-- 
-	| JMP_TBL	AddrMode [BlockId]
+	| JMP_TBL	AddrMode [Maybe BlockId] CLabel
 
 	| CALL		(Either Imm Reg) Int Bool 	-- target, args, terminal
 
@@ -246,7 +248,7 @@ sparc_regUsageOfInstr instr
     FxTOy   _ _  r1 r2 		-> usage ([r1], 		[r2])
 
     JMP     addr 		-> usage (regAddr addr, [])
-    JMP_TBL addr _      	-> usage (regAddr addr, [])
+    JMP_TBL addr _ _    	-> usage (regAddr addr, [])
 
     CALL  (Left _  )  _ True  	-> noUsage
     CALL  (Left _  )  n False 	-> usage (argRegs n, callClobberedRegs)
@@ -270,11 +272,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)
 
 
 
@@ -316,7 +316,7 @@ sparc_patchRegsOfInstr instr env = case instr of
     FxTOy s1 s2 r1 r2   	-> FxTOy s1 s2 (env r1) (env r2)
 
     JMP     addr        	-> JMP     (fixAddr addr)
-    JMP_TBL addr ids    	-> JMP_TBL (fixAddr addr) ids
+    JMP_TBL addr ids l  	-> JMP_TBL (fixAddr addr) ids l
 
     CALL  (Left i) n t  	-> CALL (Left i) n t
     CALL  (Right r) n t 	-> CALL (Right (env r)) n t
@@ -346,7 +346,7 @@ sparc_jumpDestsOfInstr insn
   = case insn of
 	BI   _ _ id	-> [id]
 	BF   _ _ id	-> [id]
-	JMP_TBL _ ids	-> ids
+	JMP_TBL _ ids _	-> [id | Just id <- ids]
 	_		-> []
 
 
@@ -355,6 +355,7 @@ sparc_patchJumpInstr insn patchF
   = case insn of
 	BI cc annul id	-> BI cc annul (patchF id)
 	BF cc annul id	-> BF cc annul (patchF id)
+	JMP_TBL n ids l	-> JMP_TBL n (map (fmap patchF) ids) l
 	_		-> insn
 
 
@@ -370,17 +371,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
@@ -388,10 +390,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
 
@@ -432,10 +435,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.