is64BitInteger: truncate to 64 bits before testing
[ghc-hetmet.git] / compiler / nativeGen / MachCodeGen.hs
index 9dbe316..b4cd58c 100644 (file)
@@ -21,7 +21,7 @@ module MachCodeGen ( cmmTopCodeGen, InstrBlock ) where
 import MachInstrs
 import MachRegs
 import NCGMonad
-import PositionIndependentCode ( cmmMakeDynamicReference, initializePicBase )
+import PositionIndependentCode
 import RegAllocInfo ( mkBranchInstr )
 
 -- Our intermediate code:
@@ -49,6 +49,7 @@ import Control.Monad  ( mapAndUnzipM )
 import Data.Maybe      ( fromJust )
 import Data.Bits
 import Data.Word
+import Data.Int
 
 -- -----------------------------------------------------------------------------
 -- Top-level of the instruction selector
@@ -486,10 +487,14 @@ getRegisterReg (CmmGlobal mid)
 
 getRegister :: CmmExpr -> NatM Register
 
+#if !x86_64_TARGET_ARCH
+    -- on x86_64, we have %rip for PicBaseReg, but it's not a full-featured
+    -- register, it can only be used for rip-relative addressing.
 getRegister (CmmReg (CmmGlobal PicBaseReg))
   = do
       reg <- getPicBaseNat wordRep
       return (Fixed wordRep reg nilOL)
+#endif
 
 getRegister (CmmReg reg) 
   = return (Fixed (cmmRegRep reg) (getRegisterReg reg) nilOL)
@@ -761,7 +766,7 @@ getRegister leaf
 
 getRegister (CmmLit (CmmFloat f F32)) = do
     lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat False lbl
+    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let code dst =
            LDATA ReadOnlyData
@@ -784,7 +789,7 @@ getRegister (CmmLit (CmmFloat d F64))
 
   | otherwise = do
     lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat False lbl
+    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let code dst =
            LDATA ReadOnlyData
@@ -869,6 +874,13 @@ getRegister (CmmMachOp (MO_S_Conv I32 I64) [CmmLoad addr _]) = do
 #endif
 
 #if x86_64_TARGET_ARCH
+getRegister (CmmMachOp (MO_Add I64) [CmmReg (CmmGlobal PicBaseReg),
+                                     CmmLit displacement])
+    = return $ Any I64 (\dst -> unitOL $
+        LEA I64 (OpAddr (ripRel (litToImm displacement))) (OpReg dst))
+#endif
+
+#if x86_64_TARGET_ARCH
 getRegister (CmmMachOp (MO_S_Neg F32) [x]) = do
   x_code <- getAnyReg x
   lbl <- getNewLabelNat
@@ -1683,7 +1695,7 @@ getRegister (CmmLit (CmmInt i rep))
 
 getRegister (CmmLit (CmmFloat f frep)) = do
     lbl <- getNewLabelNat
-    dynRef <- cmmMakeDynamicReference addImportNat False lbl
+    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let code dst = 
            LDATA ReadOnlyData  [CmmDataLabel lbl,
@@ -1782,6 +1794,14 @@ getAmode other
 
 -- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
+#if x86_64_TARGET_ARCH
+
+getAmode (CmmMachOp (MO_Add I64) [CmmReg (CmmGlobal PicBaseReg),
+                                     CmmLit displacement])
+    = return $ Amode (ripRel (litToImm displacement)) nilOL
+
+#endif
+
 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
 
 -- This is all just ridiculous, since it carefully undoes 
@@ -2018,7 +2038,12 @@ is64BitLit x = False
 #endif
 
 is64BitInteger :: Integer -> Bool
-is64BitInteger i = i > 0x7fffffff || i < -0x80000000
+is64BitInteger i = i64 > 0x7fffffff || i64 < -0x80000000
+  where i64 = fromIntegral i :: Int64
+  -- a CmmInt is intended to be truncated to the appropriate 
+  -- number of bits, so here we truncate it to Int64.  This is
+  -- important because e.g. -1 as a CmmInt might be either
+  -- -1 or 18446744073709551615.
 
 -- -----------------------------------------------------------------------------
 --  The 'CondCode' type:  Condition codes passed up the tree.
@@ -2041,7 +2066,7 @@ getCondCode = panic "MachCode.getCondCode: not on Alphas"
 -- yes, they really do seem to want exactly the same!
 
 getCondCode (CmmMachOp mop [x, y])
-  = ASSERT (cmmExprRep x /= I8) -- tmp, not set up to handle 8-bit comparisons
+  = 
     case mop of
       MO_Eq F32 -> condFltCode EQQ x y
       MO_Ne F32 -> condFltCode NE  x y
@@ -3092,7 +3117,7 @@ outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
   -> Maybe [GlobalReg] -> NatM InstrBlock
 outOfLineFloatOp mop res args vols
   = do
-      targetExpr <- cmmMakeDynamicReference addImportNat True lbl
+      targetExpr <- cmmMakeDynamicReference addImportNat CallReference lbl
       let target = CmmForeignCall targetExpr CCallConv
         
       if cmmRegRep res == F64
@@ -3164,7 +3189,7 @@ genCCall target dest_regs args vols = do
     let
        fp_regs_used  = reverse (drop (length fregs) (reverse allFPArgRegs))
        int_regs_used = reverse (drop (length aregs) (reverse allArgRegs))
-       arg_regs = int_regs_used ++ fp_regs_used
+       arg_regs = [eax] ++ int_regs_used ++ fp_regs_used
                -- for annotating the call instruction with
 
        sse_regs = length fp_regs_used
@@ -3448,7 +3473,7 @@ genCCall target dest_regs argsAndHints vols = do
                          )
 outOfLineFloatOp mop =
     do
-      mopExpr <- cmmMakeDynamicReference addImportNat True $
+      mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
                  mkForeignLabel functionName Nothing True
       let mopLabelOrExpr = case mopExpr of
                        CmmLit (CmmLabel lbl) -> Left lbl
@@ -3533,6 +3558,10 @@ outOfLineFloatOp mop =
     frame just before ccalling.
 -}
 
+
+genCCall (CmmPrim MO_WriteBarrier) _ _ _
+ = return $ unitOL LWSYNC
+
 genCCall target dest_regs argsAndHints vols
   = ASSERT (not $ any (`elem` [I8,I16]) argReps)
         -- we rely on argument promotion in the codeGen
@@ -3699,7 +3728,7 @@ genCCall target dest_regs argsAndHints vols
                           
         outOfLineFloatOp mop =
             do
-                mopExpr <- cmmMakeDynamicReference addImportNat True $
+                mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
                               mkForeignLabel functionName Nothing True
                 let mopLabelOrExpr = case mopExpr of
                         CmmLit (CmmLabel lbl) -> Left lbl
@@ -3759,7 +3788,7 @@ genSwitch expr ids
   = do
         (reg,e_code) <- getSomeReg expr
         lbl <- getNewLabelNat
-        dynRef <- cmmMakeDynamicReference addImportNat False lbl
+        dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let
             jumpTable = map jumpTableEntryRel ids
@@ -3773,11 +3802,25 @@ genSwitch expr ids
             op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
                                        (EAIndex reg wORD_SIZE) (ImmInt 0))
 
+#if x86_64_TARGET_ARCH && darwin_TARGET_OS
+    -- on Mac OS X/x86_64, put the jump table in the text section
+    -- to work around a limitation of the linker.
+    -- ld64 is unable to handle the relocations for
+    --     .quad L1 - L0
+    -- if L0 is not preceded by a non-anonymous label in its section.
+    
+            code = e_code `appOL` t_code `appOL` toOL [
+                            ADD wordRep op (OpReg tableReg),
+                            JMP_TBL (OpReg tableReg) [ id | Just id <- ids ],
+                            LDATA Text (CmmDataLabel lbl : jumpTable)
+                    ]
+#else
             code = e_code `appOL` t_code `appOL` toOL [
                             LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
                             ADD wordRep op (OpReg tableReg),
                             JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
                     ]
+#endif
         return code
   | otherwise
   = do
@@ -3799,7 +3842,7 @@ genSwitch expr ids
         (reg,e_code) <- getSomeReg expr
         tmp <- getNewRegNat I32
         lbl <- getNewLabelNat
-        dynRef <- cmmMakeDynamicReference addImportNat False lbl
+        dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
         (tableReg,t_code) <- getSomeReg $ dynRef
         let
             jumpTable = map jumpTableEntryRel ids
@@ -4638,7 +4681,7 @@ coerceInt2FP fromRep toRep x = do
     lbl <- getNewLabelNat
     itmp <- getNewRegNat I32
     ftmp <- getNewRegNat F64
-    dynRef <- cmmMakeDynamicReference addImportNat False lbl
+    dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
     Amode addr addr_code <- getAmode dynRef
     let
        code' dst = code `appOL` maybe_exts `appOL` toOL [