X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=b4cd58c74687f24e02751af522f85296f68e99c8;hb=afe70e601965aec90b6bc86571ff54a4093f739f;hp=9dbe316d16631c4c623aca28dc522c677a7e690b;hpb=08560cf0e3a2a1928650ca5d5d0bb44fbac2ea44;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs index 9dbe316..b4cd58c 100644 --- a/compiler/nativeGen/MachCodeGen.hs +++ b/compiler/nativeGen/MachCodeGen.hs @@ -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 [