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 a940566..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"
@@ -45,6 +52,7 @@ import Constants      ( wORD_SIZE )
 import Outputable      ( assertPanic )
 import Debug.Trace     ( trace )
 #endif
+import Debug.Trace     ( trace )
 
 import Control.Monad   ( mapAndUnzipM )
 import Data.Maybe      ( fromJust )
@@ -120,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
@@ -370,7 +378,7 @@ assignMem_I64Code addrTree valueTree = do
        -- in
        return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
 
-assignReg_I64Code (CmmLocal (LocalReg u_dst pk)) valueTree = do
+assignReg_I64Code (CmmLocal (LocalReg u_dst pk _)) valueTree = do
    ChildCode64 vcode r_src_lo <- iselExpr64 valueTree
    let 
          r_dst_lo = mkVReg u_dst I32
@@ -434,6 +442,13 @@ iselExpr64 (CmmMachOp (MO_Add _) [e1,e2]) = do
    -- in
    return (ChildCode64 code rlo)
 
+iselExpr64 (CmmMachOp (MO_U_Conv I32 I64) [expr]) = do
+    (expr_reg,expr_code) <- getSomeReg expr
+    (rlo, rhi) <- getNewRegPairNat I32
+    let mov_hi = LI rhi (ImmInt 0)
+        mov_lo = MR rlo expr_reg
+    return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
+                         rlo
 iselExpr64 expr
    = pprPanic "iselExpr64(powerpc)" (ppr expr)
 
@@ -778,7 +793,8 @@ getRegister leaf
 
 getRegister (CmmLit (CmmFloat f F32)) = do
     lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+    dflags <- getDynFlagsNat
+    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let code dst =
            LDATA ReadOnlyData
@@ -801,7 +817,8 @@ getRegister (CmmLit (CmmFloat d F64))
 
   | otherwise = do
     lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+    dflags <- getDynFlagsNat
+    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let code dst =
            LDATA ReadOnlyData
@@ -1721,7 +1738,8 @@ getRegister (CmmLit (CmmInt i rep))
 
 getRegister (CmmLit (CmmFloat f frep)) = do
     lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+    dflags <- getDynFlagsNat
+    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let code dst = 
            LDATA ReadOnlyData  [CmmDataLabel lbl,
@@ -2210,6 +2228,18 @@ condIntCode cond (CmmLoad x pk) (CmmLit lit) | not (is64BitLit lit) = do
     --
     return (CondCode False cond code)
 
+-- anything vs zero, using a mask
+-- TODO: Add some sanity checking!!!!
+condIntCode cond (CmmMachOp (MO_And rep) [x,o2]) (CmmLit (CmmInt 0 pk))
+    | (CmmLit (CmmInt mask pk2)) <- o2
+    = do
+      (x_reg, x_code) <- getSomeReg x
+      let
+         code = x_code `snocOL`
+                TEST pk (OpImm (ImmInteger mask)) (OpReg x_reg)
+      --
+      return (CondCode False cond code)
+
 -- anything vs zero
 condIntCode cond x (CmmLit (CmmInt 0 pk)) = do
     (x_reg, x_code) <- getSomeReg x
@@ -3066,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)
@@ -3177,18 +3207,19 @@ outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals
   -> NatM InstrBlock
 outOfLineFloatOp mop res args
   = do
-      targetExpr <- cmmMakeDynamicReference addImportNat CallReference lbl
-      let target = CmmForeignCall targetExpr CCallConv
+      dflags <- getDynFlagsNat
+      targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
+      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
@@ -3283,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)
 
@@ -3437,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
@@ -3533,7 +3564,8 @@ genCCall target dest_regs argsAndHints = do
                          )
 outOfLineFloatOp mop =
     do
-      mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
+      dflags <- getDynFlagsNat
+      mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
                  mkForeignLabel functionName Nothing True
       let mopLabelOrExpr = case mopExpr of
                        CmmLit (CmmLabel lbl) -> Left lbl
@@ -3619,7 +3651,7 @@ outOfLineFloatOp mop =
 -}
 
 
-genCCall (CmmPrim MO_WriteBarrier) _ _ _
+genCCall (CmmPrim MO_WriteBarrier) _ _ 
  = return $ unitOL LWSYNC
 
 genCCall target dest_regs argsAndHints
@@ -3633,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
@@ -3783,12 +3815,13 @@ genCCall target dest_regs argsAndHints
                     | rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3,
                                           MR r_dest r4]
                     | otherwise -> unitOL (MR r_dest r3)
-                    where rep = cmmRegRep dest
-                          r_dest = getRegisterReg dest
+                    where rep = cmmRegRep (CmmLocal dest)
+                          r_dest = getRegisterReg (CmmLocal dest)
                           
         outOfLineFloatOp mop =
             do
-                mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
+                dflags <- getDynFlagsNat
+                mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
                               mkForeignLabel functionName Nothing True
                 let mopLabelOrExpr = case mopExpr of
                         CmmLit (CmmLabel lbl) -> Left lbl
@@ -3848,7 +3881,8 @@ genSwitch expr ids
   = do
         (reg,e_code) <- getSomeReg expr
         lbl <- getNewLabelNat
-        dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+        dflags <- getDynFlagsNat
+        dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let
             jumpTable = map jumpTableEntryRel ids
@@ -3902,7 +3936,8 @@ genSwitch expr ids
         (reg,e_code) <- getSomeReg expr
         tmp <- getNewRegNat I32
         lbl <- getNewLabelNat
-        dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+        dflags <- getDynFlagsNat
+        dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let
             jumpTable = map jumpTableEntryRel ids
@@ -4743,7 +4778,8 @@ coerceInt2FP fromRep toRep x = do
     lbl <- getNewLabelNat
     itmp <- getNewRegNat I32
     ftmp <- getNewRegNat F64
-    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+    dflags <- getDynFlagsNat
+    dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let
        code' dst = code `appOL` maybe_exts `appOL` toOL [