X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FSPARC%2FCodeGen%2FCCall.hs;h=7445f7168eedd35bcebe60780a7a8742a6840d24;hb=HEAD;hp=be789729c8b45e8e6eff10fcec539664e707b6cd;hpb=f9288086f935c97812b2d80defcff38baf7b6a6c;p=ghc-hetmet.git

diff --git a/compiler/nativeGen/SPARC/CodeGen/CCall.hs b/compiler/nativeGen/SPARC/CodeGen/CCall.hs
index be78972..7445f71 100644
--- a/compiler/nativeGen/SPARC/CodeGen/CCall.hs
+++ b/compiler/nativeGen/SPARC/CodeGen/CCall.hs
@@ -19,7 +19,7 @@ import Instruction
 import Size
 import Reg
 
-import Cmm
+import OldCmm
 import CLabel
 import BasicTypes
 
@@ -62,9 +62,9 @@ import Outputable
 -}
 
 genCCall
-    :: CmmCallTarget		-- function to call
-    -> HintedCmmFormals		-- where to put the result
-    -> HintedCmmActuals		-- arguments (of mixed type)
+    :: CmmCallTarget            -- function to call
+    -> [HintedCmmFormal]        -- where to put the result
+    -> [HintedCmmActual]        -- arguments (of mixed type)
     -> NatM InstrBlock
 
 
@@ -80,9 +80,19 @@ genCCall (CmmPrim (MO_WriteBarrier)) _ _
 
 genCCall target dest_regs argsAndHints 
  = do	 	
+        -- need to remove alignment information
+        let argsAndHints' | (CmmPrim mop) <- target,
+                            (mop == MO_Memcpy ||
+                             mop == MO_Memset ||
+                             mop == MO_Memmove)
+                          = init argsAndHints
+
+                          | otherwise
+                          = argsAndHints
+                
 	-- strip hints from the arg regs
 	let args :: [CmmExpr]
-	    args  = map hintlessCmm argsAndHints
+	    args  = map hintlessCmm argsAndHints'
 
 
 	-- work out the arguments, and assign them to integer regs
@@ -104,7 +114,7 @@ genCCall target dest_regs argsAndHints
 			return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
 
 		CmmPrim mop 
-		 -> do	res	<- outOfLineFloatOp mop
+		 -> do	res	<- outOfLineMachOp mop
 			lblOrMopExpr <- case res of
 				Left lbl -> do
 					return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
@@ -253,17 +263,17 @@ assign_code _
 
 
 -- | Generate a call to implement an out-of-line floating point operation
-outOfLineFloatOp 
+outOfLineMachOp
 	:: CallishMachOp 
 	-> NatM (Either CLabel CmmExpr)
 
-outOfLineFloatOp mop 
+outOfLineMachOp mop 
  = do	let functionName
- 		= outOfLineFloatOp_table mop
+ 		= outOfLineMachOp_table mop
 	
  	dflags	<- getDynFlagsNat
 	mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference 
-		$  mkForeignLabel functionName Nothing True IsFunction
+		$  mkForeignLabel functionName Nothing ForeignLabelInExternalPackage IsFunction
 
 	let mopLabelOrExpr 
 		= case mopExpr of
@@ -275,11 +285,11 @@ outOfLineFloatOp mop
 
 -- | Decide what C function to use to implement a CallishMachOp
 --
-outOfLineFloatOp_table 
+outOfLineMachOp_table 
 	:: CallishMachOp
 	-> FastString
 	
-outOfLineFloatOp_table mop
+outOfLineMachOp_table mop
  = case mop of
 	MO_F32_Exp    -> fsLit "expf"
 	MO_F32_Log    -> fsLit "logf"
@@ -315,5 +325,9 @@ outOfLineFloatOp_table mop
 	MO_F64_Cosh   -> fsLit "cosh"
 	MO_F64_Tanh   -> fsLit "tanh"
 
-	_ -> pprPanic "outOfLineFloatOp(sparc): Unknown callish mach op "
+        MO_Memcpy    -> fsLit "memcpy"
+        MO_Memset    -> fsLit "memset"
+        MO_Memmove   -> fsLit "memmove"
+
+	_ -> pprPanic "outOfLineMachOp(sparc): Unknown callish mach op "
               		(pprCallishMachOp mop)