X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=b685c9db7f14094a49350957fd4c07f32025a8d1;hb=70800c2246c28ca1cc8152876372b9a62cac84ed;hp=e90b40cd2c7a8f8b7d4ac811c3f9c13c0f71850b;hpb=6822f86c440bece1fc053336a75dac264325d077;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index e90b40c..b685c9d 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -3667,6 +3667,12 @@ genCCall target dest_regs argsAndHints = do
 			| not $ isFloatType rep
 			, W32	<- width
 			= unitOL $ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest
+
+			| not $ isFloatType rep
+			, W64		<- width
+			, r_dest_hi	<- getHiVRegFromLo r_dest
+			= toOL 	[ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest_hi
+				, mkRegRegMoveInstr (RealReg $ oReg 1) r_dest]
 			
 	   in	result
 				
@@ -4173,15 +4179,43 @@ genSwitch expr ids
         return code
 #elif sparc_TARGET_ARCH
 genSwitch expr ids
-  | opt_PIC
-  = error "MachCodeGen: sparc genSwitch PIC not finished\n"
+	| opt_PIC
+	= error "MachCodeGen: sparc genSwitch PIC not finished\n"
   
-  | otherwise
-  = error "MachCodeGen: sparc genSwitch non-PIC not finished\n"
+	| otherwise
+	= do	(e_reg, e_code) <- getSomeReg expr
+
+		base_reg	<- getNewRegNat II32
+		offset_reg	<- getNewRegNat II32
+		dst		<- getNewRegNat II32
+
+		label 		<- getNewLabelNat
+		let jumpTable	= map jumpTableEntry ids
+
+		return $ e_code `appOL`
+		 toOL	
+		 	-- the jump table
+			[ LDATA ReadOnlyData (CmmDataLabel label : jumpTable)
+
+			-- load base of jump table
+			, SETHI (HI (ImmCLbl label)) base_reg
+			, OR    False base_reg (RIImm $ LO $ ImmCLbl label) base_reg
+			
+			-- the addrs in the table are 32 bits wide..
+			, SLL   e_reg (RIImm $ ImmInt 2) offset_reg
+
+			-- load and jump to the destination
+			, LD 	II32 (AddrRegReg base_reg offset_reg) dst
+			, JMP   (AddrRegImm dst (ImmInt 0)) 
+			, NOP ]
+
 #else
 #error "ToDo: genSwitch"
 #endif
 
+
+-- | Convert a BlockId to some CmmStatic data
+jumpTableEntry :: Maybe BlockId -> CmmStatic
 jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
 jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
     where blockLabel = mkAsmTempLabel id
@@ -4954,21 +4988,33 @@ coerceInt2FP width1 width2 x = do
     	    FxTOy (intSize width1) (floatSize width2) dst dst]
     return (Any (floatSize $ width2) code__2)
 
-------------
-coerceFP2Int width1 width2 x = do
-    let pk	= intSize width1
-        fprep	= floatSize width2
 
-    (src, code) <- getSomeReg x
-    reg <- getNewRegNat fprep
-    tmp <- getNewRegNat pk
-    let
-    	code__2 dst = ASSERT(fprep == FF64 || fprep == FF32)
-	    code `appOL` toOL [
-    	    FxTOy fprep pk src tmp,
-    	    ST pk tmp (spRel (-2)),
-    	    LD pk (spRel (-2)) dst]
-    return (Any pk code__2)
+-- | Coerce a floating point value to integer
+--
+--   NOTE: On sparc v9 there are no instructions to move a value from an
+--	   FP register directly to an int register, so we have to use a load/store.
+--
+coerceFP2Int width1 width2 x 
+ = do	let fsize1	= floatSize width1
+	    fsize2	= floatSize width2
+	
+            isize2	= intSize   width2
+
+	(fsrc, code)	<- getSomeReg x
+	fdst		<- getNewRegNat fsize2
+    
+	let code2 dst	
+		= 	code
+		`appOL` toOL
+			-- convert float to int format, leaving it in a float reg.
+			[ FxTOy fsize1 isize2 fsrc fdst
+
+			-- store the int into mem, then load it back to move
+			--	it into an actual int reg.
+			, ST    fsize2 fdst (spRel (-2))
+			, LD	isize2 (spRel (-2)) dst]
+
+	return (Any isize2 code2)
 
 ------------
 coerceDbl2Flt x = do