Use OPTIONS rather than OPTIONS_GHC for pragmas

[ghc-hetmet.git] / compiler / nativeGen / MachCodeGen.hs

diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index d07803d..ce24fc5 100644 (file)
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -11,6 +11,13 @@
 -- (c) the #if blah_TARGET_ARCH} things, the
 -- structure should not be too overwhelming.
 
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+
 module MachCodeGen ( cmmTopCodeGen, InstrBlock ) where
 
 #include "HsVersions.h"
@@ -121,7 +128,7 @@ stmtToInstrs stmt = case stmt of
       | otherwise       -> assignMem_IntCode kind addr src
        where kind = cmmExprRep src
 
-    CmmCall target result_regs args _
+    CmmCall target result_regs args _ _
        -> genCCall target result_regs args
 
     CmmBranch id         -> genBranch id
@@ -3089,11 +3096,11 @@ genCCall target dest_regs args = do
     (callinsns,cconv) <-
       case target of
        -- CmmPrim -> ...
-        CmmForeignCall (CmmLit (CmmLabel lbl)) conv
+        CmmCallee (CmmLit (CmmLabel lbl)) conv
            -> -- ToDo: stdcall arg sizes
              return (unitOL (CALL (Left fn_imm) []), conv)
           where fn_imm = ImmCLbl lbl
-        CmmForeignCall expr conv
+        CmmCallee expr conv
            -> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
                  ASSERT(dyn_rep == I32)
                   return (dyn_c `snocOL` CALL (Right dyn_r) [], conv)
@@ -3202,17 +3209,17 @@ outOfLineFloatOp mop res args
   = do
       dflags <- getDynFlagsNat
       targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
-      let target = CmmForeignCall targetExpr CCallConv
+      let target = CmmCallee targetExpr CCallConv
         
       if localRegRep res == F64
         then
-          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe)
+          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn)
         else do
           uq <- getUniqueNat
           let 
             tmp = LocalReg uq F64 KindNonPtr
           -- in
-          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe)
+          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
           code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
           return (code1 `appOL` code2)
   where
@@ -3307,11 +3314,11 @@ genCCall target dest_regs args = do
     (callinsns,cconv) <-
       case target of
        -- CmmPrim -> ...
-        CmmForeignCall (CmmLit (CmmLabel lbl)) conv
+        CmmCallee (CmmLit (CmmLabel lbl)) conv
            -> -- ToDo: stdcall arg sizes
              return (unitOL (CALL (Left fn_imm) arg_regs), conv)
           where fn_imm = ImmCLbl lbl
-        CmmForeignCall expr conv
+        CmmCallee expr conv
            -> do (dyn_r, dyn_c) <- getSomeReg expr
                 return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
 
@@ -3461,9 +3468,9 @@ genCCall target dest_regs argsAndHints = do
         vregs              = concat vregss
     -- deal with static vs dynamic call targets
     callinsns <- (case target of
-        CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> do
+        CmmCallee (CmmLit (CmmLabel lbl)) conv -> do
                return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
-        CmmForeignCall expr conv -> do
+        CmmCallee expr conv -> do
                 (dyn_c, [dyn_r]) <- arg_to_int_vregs expr
                 return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
        CmmPrim mop -> do
@@ -3658,8 +3665,8 @@ genCCall target dest_regs argsAndHints
                                                         (toOL []) []
                                                 
         (labelOrExpr, reduceToF32) <- case target of
-            CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
-            CmmForeignCall expr conv -> return  (Right expr, False)
+            CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
+            CmmCallee expr conv -> return  (Right expr, False)
             CmmPrim mop -> outOfLineFloatOp mop
                                                         
         let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode