Remove type synonyms for CmmFormals, CmmActuals (and hinted versions).

[ghc-hetmet.git] / compiler / nativeGen / SPARC / CodeGen / CCall.hs

diff --git a/compiler/nativeGen/SPARC/CodeGen/CCall.hs b/compiler/nativeGen/SPARC/CodeGen/CCall.hs
index 3d10cef..7445f71 100644 (file)
--- 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))
@@ -159,14 +169,12 @@ arg_to_int_vregs arg
                        v1 <- getNewRegNat II32
                        v2 <- getNewRegNat II32
 
-                       let Just f0_high = fPair f0
-                       
                        let code2 = 
                                code                            `snocOL`
                                FMOV FF64 src f0                `snocOL`
                                ST   FF32  f0 (spRel 16)        `snocOL`
                                LD   II32  (spRel 16) v1        `snocOL`
-                               ST   FF32  f0_high (spRel 16)   `snocOL`
+                               ST   FF32  f1 (spRel 16)        `snocOL`
                                LD   II32  (spRel 16) v2
 
                        return  (code2, [v1,v2])
@@ -228,21 +236,21 @@ assign_code [CmmHinted dest _hint]
        result
                | isFloatType rep 
                , W32   <- width
-               = unitOL $ FMOV FF32 (RealReg $ fReg 0) r_dest
+               = unitOL $ FMOV FF32 (regSingle $ fReg 0) r_dest
 
                | isFloatType rep
                , W64   <- width
-               = unitOL $ FMOV FF64 (RealReg $ fReg 0) r_dest
+               = unitOL $ FMOV FF64 (regSingle $ fReg 0) r_dest
 
                | not $ isFloatType rep
                , W32   <- width
-               = unitOL $ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest
+               = unitOL $ mkRegRegMoveInstr (regSingle $ 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]
+               = toOL  [ mkRegRegMoveInstr (regSingle $ oReg 0) r_dest_hi
+                       , mkRegRegMoveInstr (regSingle $ oReg 1) r_dest]
 
                | otherwise
                = panic "SPARC.CodeGen.GenCCall: no match"
@@ -255,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
@@ -277,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"
@@ -317,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)