+{-# 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/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- Generating machine code (instruction selection)
import MachInstrs
import MachRegs
import NCGMonad
-import PositionIndependentCode ( cmmMakeDynamicReference, initializePicBase )
+import PositionIndependentCode
import RegAllocInfo ( mkBranchInstr )
-- Our intermediate code:
+import BlockId
import PprCmm ( pprExpr )
import Cmm
import MachOp
import CLabel
+import ClosureInfo ( C_SRT(..) )
-- The rest:
import StaticFlags ( opt_PIC )
import Pretty
import Outputable
import FastString
-import FastTypes ( isFastTrue )
+import FastBool ( isFastTrue )
import Constants ( wORD_SIZE )
-#ifdef DEBUG
-import Outputable ( assertPanic )
-import TRACE ( trace )
-#endif
+import Debug.Trace ( trace )
import Control.Monad ( mapAndUnzipM )
-import Maybe ( fromJust )
-import DATA_BITS
-import DATA_WORD
+import Data.Maybe ( fromJust )
+import Data.Bits
+import Data.Word
+import Data.Int
-- -----------------------------------------------------------------------------
-- Top-level of the instruction selector
type InstrBlock = OrdList Instr
-cmmTopCodeGen :: CmmTop -> NatM [NatCmmTop]
-cmmTopCodeGen (CmmProc info lab params blocks) = do
+cmmTopCodeGen :: RawCmmTop -> NatM [NatCmmTop]
+cmmTopCodeGen (CmmProc info lab params (ListGraph blocks)) = do
(nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
picBaseMb <- getPicBaseMaybeNat
- let proc = CmmProc info lab params (concat nat_blocks)
+ let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
tops = proc : concat statics
case picBaseMb of
Just picBase -> initializePicBase picBase tops
| otherwise -> assignMem_IntCode kind addr src
where kind = cmmExprRep src
- CmmCall target result_regs args vols
- -> genCCall target result_regs args vols
+ CmmCall target result_regs args _ _
+ -> genCCall target result_regs args
CmmBranch id -> genBranch id
CmmCondBranch arg id -> genCondJump id arg
CmmSwitch arg ids -> genSwitch arg ids
CmmJump arg params -> genJump arg
+ CmmReturn params ->
+ panic "stmtToInstrs: return statement should have been cps'd away"
-- -----------------------------------------------------------------------------
-- General things for putting together code sequences
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
rlo
)
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
+iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _)))
= return (ChildCode64 nilOL (mkVReg vu I32))
-- we handle addition, but rather badly
-- in
return (ChildCode64 code rlo)
+iselExpr64 (CmmMachOp (MO_U_Conv _ I64) [expr]) = do
+ fn <- getAnyReg expr
+ r_dst_lo <- getNewRegNat I32
+ let r_dst_hi = getHiVRegFromLo r_dst_lo
+ code = fn r_dst_lo
+ return (
+ ChildCode64 (code `snocOL`
+ MOV I32 (OpImm (ImmInt 0)) (OpReg r_dst_hi))
+ r_dst_lo
+ )
+
iselExpr64 expr
= pprPanic "iselExpr64(i386)" (ppr expr)
mov_lo = ST I32 rlo (AddrRegImm src (ImmInt 4))
return (vcode `appOL` code `snocOL` mov_hi `snocOL` mov_lo)
-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 pk
rlo
)
-iselExpr64 (CmmReg (CmmLocal (LocalReg uq I64))) = do
+iselExpr64 (CmmReg (CmmLocal (LocalReg uq I64 _))) = do
r_dst_lo <- getNewRegNat I32
let r_dst_hi = getHiVRegFromLo r_dst_lo
r_src_lo = mkVReg uq I32
-- 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
return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
rlo
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
+iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _)))
= return (ChildCode64 nilOL (mkVReg vu I32))
iselExpr64 (CmmLit (CmmInt i _)) = 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)
getRegisterReg :: CmmReg -> Reg
-getRegisterReg (CmmLocal (LocalReg u pk))
+getRegisterReg (CmmLocal (LocalReg u pk _))
= mkVReg u pk
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)
getRegister tree@(CmmRegOff _ _)
= getRegister (mangleIndexTree tree)
+
+#if WORD_SIZE_IN_BITS==32
+ -- for 32-bit architectuers, support some 64 -> 32 bit conversions:
+ -- TO_W_(x), TO_W_(x >> 32)
+
+getRegister (CmmMachOp (MO_U_Conv I64 I32)
+ [CmmMachOp (MO_U_Shr I64) [x,CmmLit (CmmInt 32 _)]]) = do
+ ChildCode64 code rlo <- iselExpr64 x
+ return $ Fixed I32 (getHiVRegFromLo rlo) code
+
+getRegister (CmmMachOp (MO_S_Conv I64 I32)
+ [CmmMachOp (MO_U_Shr I64) [x,CmmLit (CmmInt 32 _)]]) = do
+ ChildCode64 code rlo <- iselExpr64 x
+ return $ Fixed I32 (getHiVRegFromLo rlo) code
+
+getRegister (CmmMachOp (MO_U_Conv I64 I32) [x]) = do
+ ChildCode64 code rlo <- iselExpr64 x
+ return $ Fixed I32 rlo code
+
+getRegister (CmmMachOp (MO_S_Conv I64 I32) [x]) = do
+ ChildCode64 code rlo <- iselExpr64 x
+ return $ Fixed I32 rlo code
+
+#endif
+
-- end of machine-"independent" bit; here we go on the rest...
#if alpha_TARGET_ARCH
other_op -> getRegister (StCall fn CCallConv F64 [x])
where
fn = case other_op of
- FloatExpOp -> FSLIT("exp")
- FloatLogOp -> FSLIT("log")
- FloatSqrtOp -> FSLIT("sqrt")
- FloatSinOp -> FSLIT("sin")
- FloatCosOp -> FSLIT("cos")
- FloatTanOp -> FSLIT("tan")
- FloatAsinOp -> FSLIT("asin")
- FloatAcosOp -> FSLIT("acos")
- FloatAtanOp -> FSLIT("atan")
- FloatSinhOp -> FSLIT("sinh")
- FloatCoshOp -> FSLIT("cosh")
- FloatTanhOp -> FSLIT("tanh")
- DoubleExpOp -> FSLIT("exp")
- DoubleLogOp -> FSLIT("log")
- DoubleSqrtOp -> FSLIT("sqrt")
- DoubleSinOp -> FSLIT("sin")
- DoubleCosOp -> FSLIT("cos")
- DoubleTanOp -> FSLIT("tan")
- DoubleAsinOp -> FSLIT("asin")
- DoubleAcosOp -> FSLIT("acos")
- DoubleAtanOp -> FSLIT("atan")
- DoubleSinhOp -> FSLIT("sinh")
- DoubleCoshOp -> FSLIT("cosh")
- DoubleTanhOp -> FSLIT("tanh")
+ FloatExpOp -> fsLit "exp"
+ FloatLogOp -> fsLit "log"
+ FloatSqrtOp -> fsLit "sqrt"
+ FloatSinOp -> fsLit "sin"
+ FloatCosOp -> fsLit "cos"
+ FloatTanOp -> fsLit "tan"
+ FloatAsinOp -> fsLit "asin"
+ FloatAcosOp -> fsLit "acos"
+ FloatAtanOp -> fsLit "atan"
+ FloatSinhOp -> fsLit "sinh"
+ FloatCoshOp -> fsLit "cosh"
+ FloatTanhOp -> fsLit "tanh"
+ DoubleExpOp -> fsLit "exp"
+ DoubleLogOp -> fsLit "log"
+ DoubleSqrtOp -> fsLit "sqrt"
+ DoubleSinOp -> fsLit "sin"
+ DoubleCosOp -> fsLit "cos"
+ DoubleTanOp -> fsLit "tan"
+ DoubleAsinOp -> fsLit "asin"
+ DoubleAcosOp -> fsLit "acos"
+ DoubleAtanOp -> fsLit "atan"
+ DoubleSinhOp -> fsLit "sinh"
+ DoubleCoshOp -> fsLit "cosh"
+ DoubleTanhOp -> fsLit "tanh"
where
pr = panic "MachCode.getRegister: no primrep needed for Alpha"
ISraOp -> trivialCode SRA x y -- was: panic "AlphaGen:isra"
ISrlOp -> trivialCode SRL x y -- was: panic "AlphaGen:isrl"
- FloatPowerOp -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
- DoublePowerOp -> getRegister (StCall FSLIT("pow") CCallConv F64 [x,y])
+ FloatPowerOp -> getRegister (StCall (fsLit "pow") CCallConv F64 [x,y])
+ DoublePowerOp -> getRegister (StCall (fsLit "pow") CCallConv F64 [x,y])
where
{- ------------------------------------------------------------
Some bizarre special code for getting condition codes into
getRegister (CmmLit (CmmFloat f F32)) = do
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat False lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData
| otherwise = do
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat False lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData
#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
getRegister e@(CmmMachOp mop [x, y]) -- dyadic MachOps
- = ASSERT2(cmmExprRep x /= I8, pprExpr e)
- case mop of
+ = case mop of
MO_Eq F32 -> condFltReg EQQ x y
MO_Ne F32 -> condFltReg NE x y
MO_S_Gt F32 -> condFltReg GTT x y
-- in
return (Any rep code)
- {- Case2: shift length is complex (non-immediate) -}
+ {- Case2: shift length is complex (non-immediate)
+ * y must go in %ecx.
+ * we cannot do y first *and* put its result in %ecx, because
+ %ecx might be clobbered by x.
+ * if we do y second, then x cannot be
+ in a clobbered reg. Also, we cannot clobber x's reg
+ with the instruction itself.
+ * so we can either:
+ - do y first, put its result in a fresh tmp, then copy it to %ecx later
+ - do y second and put its result into %ecx. x gets placed in a fresh
+ tmp. This is likely to be better, becuase the reg alloc can
+ eliminate this reg->reg move here (it won't eliminate the other one,
+ because the move is into the fixed %ecx).
+ -}
shift_code rep instr x y{-amount-} = do
- (x_reg, x_code) <- getNonClobberedReg x
+ x_code <- getAnyReg x
+ tmp <- getNewRegNat rep
y_code <- getAnyReg y
let
- code = x_code `appOL`
+ code = x_code tmp `appOL`
y_code ecx `snocOL`
- instr (OpReg ecx) (OpReg x_reg)
+ instr (OpReg ecx) (OpReg tmp)
-- in
- return (Fixed rep x_reg code)
+ return (Fixed rep tmp code)
--------------------
add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
add_code rep x (CmmLit (CmmInt y _))
- | not (is64BitInteger y) = add_int rep x y
+ | is32BitInteger y = add_int rep x y
add_code rep x y = trivialCode rep (ADD rep) (Just (ADD rep)) x y
--------------------
sub_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
sub_code rep x (CmmLit (CmmInt y _))
- | not (is64BitInteger (-y)) = add_int rep x (-y)
+ | is32BitInteger (-y) = add_int rep x (-y)
sub_code rep x y = trivialCode rep (SUB rep) Nothing x y
-- our three-operand add instruction:
where
isBigLit (CmmInt i I64) = i < 0 || i > 0xffffffff
isBigLit _ = False
- -- note1: not the same as is64BitLit, because that checks for
+ -- note1: not the same as (not.is32BitLit), because that checks for
-- signed literals that fit in 32 bits, but we want unsigned
-- literals here.
-- note2: all labels are small, because we're assuming the
MO_S_MulMayOflo rep -> imulMayOflo rep x y
{-
-- ToDo: teach about V8+ SPARC div instructions
- MO_S_Quot I32 -> idiv FSLIT(".div") x y
- MO_S_Rem I32 -> idiv FSLIT(".rem") x y
- MO_U_Quot I32 -> idiv FSLIT(".udiv") x y
- MO_U_Rem I32 -> idiv FSLIT(".urem") x y
+ MO_S_Quot I32 -> idiv (fsLit ".div") x y
+ MO_S_Rem I32 -> idiv (fsLit ".rem") x y
+ MO_U_Quot I32 -> idiv (fsLit ".udiv") x y
+ MO_U_Rem I32 -> idiv (fsLit ".urem") x y
-}
MO_Add F32 -> trivialFCode F32 FADD x y
MO_Sub F32 -> trivialFCode F32 FSUB x y
MO_S_Shr rep -> trivialCode rep SRA x y
{-
- MO_F32_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64
+ MO_F32_Pwr -> getRegister (StCall (Left (fsLit "pow")) CCallConv F64
[promote x, promote y])
where promote x = CmmMachOp MO_F32_to_Dbl [x]
- MO_F64_Pwr -> getRegister (StCall (Left FSLIT("pow")) CCallConv F64
+ MO_F64_Pwr -> getRegister (StCall (Left (fsLit "pow")) CCallConv F64
[x, y])
-}
other -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
getRegister (CmmLit (CmmFloat f frep)) = do
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat False lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData [CmmDataLabel lbl,
= let rep = cmmLitRep lit
imm = litToImm lit
code dst = toOL [
- LIS dst (HI imm),
- OR dst dst (RIImm (LO imm))
+ LIS dst (HA imm),
+ ADD dst dst (RIImm (LO imm))
]
in return (Any rep code)
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
+#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
-- what mangleIndexTree has just done.
getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)])
- | not (is64BitLit lit)
+ | is32BitLit lit
-- ASSERT(rep == I32)???
= do (x_reg, x_code) <- getSomeReg x
let off = ImmInt (-(fromInteger i))
return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit@(CmmInt i _)])
- | not (is64BitLit lit)
+ | is32BitLit lit
-- ASSERT(rep == I32)???
= do (x_reg, x_code) <- getSomeReg x
let off = ImmInt (fromInteger i)
getAmode (CmmMachOp (MO_Add rep) [x, CmmMachOp (MO_Shl _)
[y, CmmLit (CmmInt shift _)]])
| shift == 0 || shift == 1 || shift == 2 || shift == 3
- = do (x_reg, x_code) <- getNonClobberedReg x
- -- x must be in a temp, because it has to stay live over y_code
- -- we could compre x_reg and y_reg and do something better here...
- (y_reg, y_code) <- getSomeReg y
- let
- code = x_code `appOL` y_code
- base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8
- return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt 0))
- code)
+ = x86_complex_amode x y shift 0
+
+getAmode (CmmMachOp (MO_Add rep)
+ [x, CmmMachOp (MO_Add _)
+ [CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)],
+ CmmLit (CmmInt offset _)]])
+ | shift == 0 || shift == 1 || shift == 2 || shift == 3
+ && is32BitInteger offset
+ = x86_complex_amode x y shift offset
-getAmode (CmmLit lit) | not (is64BitLit lit)
+getAmode (CmmMachOp (MO_Add rep) [x,y])
+ = x86_complex_amode x y 0 0
+
+getAmode (CmmLit lit) | is32BitLit lit
= return (Amode (ImmAddr (litToImm lit) 0) nilOL)
getAmode expr = do
(reg,code) <- getSomeReg expr
return (Amode (AddrBaseIndex (EABaseReg reg) EAIndexNone (ImmInt 0)) code)
+
+x86_complex_amode :: CmmExpr -> CmmExpr -> Integer -> Integer -> NatM Amode
+x86_complex_amode base index shift offset
+ = do (x_reg, x_code) <- getNonClobberedReg base
+ -- x must be in a temp, because it has to stay live over y_code
+ -- we could compre x_reg and y_reg and do something better here...
+ (y_reg, y_code) <- getSomeReg index
+ let
+ code = x_code `appOL` y_code
+ base = case shift of 0 -> 1; 1 -> 2; 2 -> 4; 3 -> 8
+ return (Amode (AddrBaseIndex (EABaseReg x_reg) (EAIndex y_reg base) (ImmInt (fromIntegral offset)))
+ code)
+
#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
return (OpAddr (ripRel (ImmCLbl lbl)), code)
#endif
getNonClobberedOperand (CmmLit lit)
- | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) =
+ | is32BitLit lit && not (isFloatingRep (cmmLitRep lit)) =
return (OpImm (litToImm lit), nilOL)
getNonClobberedOperand (CmmLoad mem pk)
| IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
return (OpAddr (ripRel (ImmCLbl lbl)), code)
#endif
getOperand (CmmLit lit)
- | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) = do
+ | is32BitLit lit && not (isFloatingRep (cmmLitRep lit)) = do
return (OpImm (litToImm lit), nilOL)
getOperand (CmmLoad mem pk)
| IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
isOperand :: CmmExpr -> Bool
isOperand (CmmLoad _ _) = True
-isOperand (CmmLit lit) = not (is64BitLit lit)
+isOperand (CmmLit lit) = is32BitLit lit
|| isSuitableFloatingPointLit lit
isOperand _ = False
return (OpReg reg, code)
#if x86_64_TARGET_ARCH
-is64BitLit (CmmInt i I64) = is64BitInteger i
+is32BitLit (CmmInt i I64) = is32BitInteger i
-- assume that labels are in the range 0-2^31-1: this assumes the
-- small memory model (see gcc docs, -mcmodel=small).
#endif
-is64BitLit x = False
+is32BitLit x = True
#endif
-is64BitInteger :: Integer -> Bool
-is64BitInteger i = i > 0x7fffffff || i < -0x80000000
+is32BitInteger :: Integer -> Bool
+is32BitInteger 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.
-- 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
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-- memory vs immediate
-condIntCode cond (CmmLoad x pk) (CmmLit lit) | not (is64BitLit lit) = do
+condIntCode cond (CmmLoad x pk) (CmmLit lit) | is32BitLit lit = do
Amode x_addr x_code <- getAmode x
let
imm = litToImm lit
--
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 lit@(CmmInt mask pk2)) <- o2, is32BitLit lit
+ = 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
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-- integer assignment to memory
+
+-- specific case of adding/subtracting an integer to a particular address.
+-- ToDo: catch other cases where we can use an operation directly on a memory
+-- address.
+assignMem_IntCode pk addr (CmmMachOp op [CmmLoad addr2 _,
+ CmmLit (CmmInt i _)])
+ | addr == addr2, pk /= I64 || is32BitInteger i,
+ Just instr <- check op
+ = do Amode amode code_addr <- getAmode addr
+ let code = code_addr `snocOL`
+ instr pk (OpImm (ImmInt (fromIntegral i))) (OpAddr amode)
+ return code
+ where
+ check (MO_Add _) = Just ADD
+ check (MO_Sub _) = Just SUB
+ check _ = Nothing
+ -- ToDo: more?
+
+-- general case
assignMem_IntCode pk addr src = do
Amode addr code_addr <- getAmode addr
(code_src, op_src) <- get_op_RI src
return code
where
get_op_RI :: CmmExpr -> NatM (InstrBlock,Operand) -- code, operator
- get_op_RI (CmmLit lit) | not (is64BitLit lit)
+ get_op_RI (CmmLit lit) | is32BitLit lit
= return (nilOL, OpImm (litToImm lit))
get_op_RI op
= do (reg,code) <- getNonClobberedReg op
genCCall
:: CmmCallTarget -- function to call
- -> [(CmmReg,MachHint)] -- where to put the result
- -> [(CmmExpr,MachHint)] -- arguments (of mixed type)
- -> Maybe [GlobalReg] -- volatile regs to save
+ -> CmmFormals -- where to put the result
+ -> CmmActuals -- arguments (of mixed type)
-> NatM InstrBlock
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if i386_TARGET_ARCH
+genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL
+ -- write barrier compiles to no code on x86/x86-64;
+ -- we keep it this long in order to prevent earlier optimisations.
+
-- we only cope with a single result for foreign calls
-genCCall (CmmPrim op) [(r,_)] args vols = do
+genCCall (CmmPrim op) [CmmKinded r _] args = do
+ l1 <- getNewLabelNat
+ l2 <- getNewLabelNat
case op of
MO_F32_Sqrt -> actuallyInlineFloatOp F32 (GSQRT F32) args
MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args
- MO_F32_Sin -> actuallyInlineFloatOp F32 (GSIN F32) args
- MO_F64_Sin -> actuallyInlineFloatOp F64 (GSIN F64) args
+ MO_F32_Sin -> actuallyInlineFloatOp F32 (GSIN F32 l1 l2) args
+ MO_F64_Sin -> actuallyInlineFloatOp F64 (GSIN F64 l1 l2) args
- MO_F32_Cos -> actuallyInlineFloatOp F32 (GCOS F32) args
- MO_F64_Cos -> actuallyInlineFloatOp F64 (GCOS F64) args
+ MO_F32_Cos -> actuallyInlineFloatOp F32 (GCOS F32 l1 l2) args
+ MO_F64_Cos -> actuallyInlineFloatOp F64 (GCOS F64 l1 l2) args
- MO_F32_Tan -> actuallyInlineFloatOp F32 (GTAN F32) args
- MO_F64_Tan -> actuallyInlineFloatOp F64 (GTAN F64) args
+ MO_F32_Tan -> actuallyInlineFloatOp F32 (GTAN F32 l1 l2) args
+ MO_F64_Tan -> actuallyInlineFloatOp F64 (GTAN F64 l1 l2) args
- other_op -> outOfLineFloatOp op r args vols
+ other_op -> outOfLineFloatOp op r args
where
- actuallyInlineFloatOp rep instr [(x,_)]
+ actuallyInlineFloatOp rep instr [CmmKinded x _]
= do res <- trivialUFCode rep instr x
any <- anyReg res
- return (any (getRegisterReg r))
+ return (any (getRegisterReg (CmmLocal r)))
-genCCall target dest_regs args vols = do
+genCCall target dest_regs args = do
let
- sizes = map (arg_size . cmmExprRep . fst) (reverse args)
+ sizes = map (arg_size . cmmExprRep . kindlessCmm) (reverse args)
#if !darwin_TARGET_OS
tot_arg_size = sum sizes
#else
(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)
let
-- assign the results, if necessary
assign_code [] = nilOL
- assign_code [(dest,_hint)] =
+ assign_code [CmmKinded dest _hint] =
case rep of
I64 -> toOL [MOV I32 (OpReg eax) (OpReg r_dest),
MOV I32 (OpReg edx) (OpReg r_dest_hi)]
rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest))
where
r_dest_hi = getHiVRegFromLo r_dest
- rep = cmmRegRep dest
- r_dest = getRegisterReg dest
+ rep = localRegRep dest
+ r_dest = getRegisterReg (CmmLocal dest)
assign_code many = panic "genCCall.assign_code many"
return (push_code `appOL`
| otherwise = x + a - (x `mod` a)
- push_arg :: (CmmExpr,MachHint){-current argument-}
+ push_arg :: (CmmKinded CmmExpr){-current argument-}
-> NatM InstrBlock -- code
- push_arg (arg,_hint) -- we don't need the hints on x86
+ push_arg (CmmKinded arg _hint) -- we don't need the hints on x86
| arg_rep == I64 = do
ChildCode64 code r_lo <- iselExpr64 arg
delta <- getDeltaNat
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
- -> Maybe [GlobalReg] -> NatM InstrBlock
-outOfLineFloatOp mop res args vols
+outOfLineFloatOp :: CallishMachOp -> CmmFormalWithoutKind -> CmmActuals
+ -> NatM InstrBlock
+outOfLineFloatOp mop res args
= do
- targetExpr <- cmmMakeDynamicReference addImportNat True lbl
- let target = CmmForeignCall targetExpr CCallConv
+ dflags <- getDynFlagsNat
+ targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
+ let target = CmmCallee targetExpr CCallConv
- if cmmRegRep res == F64
+ if localRegRep res == F64
then
- stmtToInstrs (CmmCall target [(res,FloatHint)] args vols)
+ stmtToInstrs (CmmCall target [CmmKinded res FloatHint] args CmmUnsafe CmmMayReturn)
else do
uq <- getUniqueNat
let
- tmp = CmmLocal (LocalReg uq F64)
+ tmp = LocalReg uq F64 GCKindNonPtr
-- in
- code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args vols)
- code2 <- stmtToInstrs (CmmAssign res (CmmReg tmp))
+ code1 <- stmtToInstrs (CmmCall target [CmmKinded tmp FloatHint] args CmmUnsafe CmmMayReturn)
+ code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
return (code1 `appOL` code2)
where
- lbl = mkForeignLabel fn Nothing True
+ lbl = mkForeignLabel fn Nothing False
fn = case mop of
- MO_F32_Sqrt -> FSLIT("sqrtf")
- MO_F32_Sin -> FSLIT("sinf")
- MO_F32_Cos -> FSLIT("cosf")
- MO_F32_Tan -> FSLIT("tanf")
- MO_F32_Exp -> FSLIT("expf")
- MO_F32_Log -> FSLIT("logf")
-
- MO_F32_Asin -> FSLIT("asinf")
- MO_F32_Acos -> FSLIT("acosf")
- MO_F32_Atan -> FSLIT("atanf")
-
- MO_F32_Sinh -> FSLIT("sinhf")
- MO_F32_Cosh -> FSLIT("coshf")
- MO_F32_Tanh -> FSLIT("tanhf")
- MO_F32_Pwr -> FSLIT("powf")
-
- MO_F64_Sqrt -> FSLIT("sqrt")
- MO_F64_Sin -> FSLIT("sin")
- MO_F64_Cos -> FSLIT("cos")
- MO_F64_Tan -> FSLIT("tan")
- MO_F64_Exp -> FSLIT("exp")
- MO_F64_Log -> FSLIT("log")
-
- MO_F64_Asin -> FSLIT("asin")
- MO_F64_Acos -> FSLIT("acos")
- MO_F64_Atan -> FSLIT("atan")
-
- MO_F64_Sinh -> FSLIT("sinh")
- MO_F64_Cosh -> FSLIT("cosh")
- MO_F64_Tanh -> FSLIT("tanh")
- MO_F64_Pwr -> FSLIT("pow")
+ MO_F32_Sqrt -> fsLit "sqrtf"
+ MO_F32_Sin -> fsLit "sinf"
+ MO_F32_Cos -> fsLit "cosf"
+ MO_F32_Tan -> fsLit "tanf"
+ MO_F32_Exp -> fsLit "expf"
+ MO_F32_Log -> fsLit "logf"
+
+ MO_F32_Asin -> fsLit "asinf"
+ MO_F32_Acos -> fsLit "acosf"
+ MO_F32_Atan -> fsLit "atanf"
+
+ MO_F32_Sinh -> fsLit "sinhf"
+ MO_F32_Cosh -> fsLit "coshf"
+ MO_F32_Tanh -> fsLit "tanhf"
+ MO_F32_Pwr -> fsLit "powf"
+
+ MO_F64_Sqrt -> fsLit "sqrt"
+ MO_F64_Sin -> fsLit "sin"
+ MO_F64_Cos -> fsLit "cos"
+ MO_F64_Tan -> fsLit "tan"
+ MO_F64_Exp -> fsLit "exp"
+ MO_F64_Log -> fsLit "log"
+
+ MO_F64_Asin -> fsLit "asin"
+ MO_F64_Acos -> fsLit "acos"
+ MO_F64_Atan -> fsLit "atan"
+
+ MO_F64_Sinh -> fsLit "sinh"
+ MO_F64_Cosh -> fsLit "cosh"
+ MO_F64_Tanh -> fsLit "tanh"
+ MO_F64_Pwr -> fsLit "pow"
#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
#if x86_64_TARGET_ARCH
-genCCall (CmmPrim op) [(r,_)] args vols =
- outOfLineFloatOp op r args vols
+genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL
+ -- write barrier compiles to no code on x86/x86-64;
+ -- we keep it this long in order to prevent earlier optimisations.
+
-genCCall target dest_regs args vols = do
+genCCall (CmmPrim op) [CmmKinded r _] args =
+ outOfLineFloatOp op r args
+
+genCCall target dest_regs args = do
-- load up the register arguments
(stack_args, aregs, fregs, load_args_code)
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
(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)
let
-- assign the results, if necessary
assign_code [] = nilOL
- assign_code [(dest,_hint)] =
+ assign_code [CmmKinded dest _hint] =
case rep of
F32 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
rep -> unitOL (MOV rep (OpReg rax) (OpReg r_dest))
where
- rep = cmmRegRep dest
- r_dest = getRegisterReg dest
+ rep = localRegRep dest
+ r_dest = getRegisterReg (CmmLocal dest)
assign_code many = panic "genCCall.assign_code many"
return (load_args_code `appOL`
where
arg_size = 8 -- always, at the mo
- load_args :: [(CmmExpr,MachHint)]
+ load_args :: [CmmKinded CmmExpr]
-> [Reg] -- int regs avail for args
-> [Reg] -- FP regs avail for args
-> InstrBlock
- -> NatM ([(CmmExpr,MachHint)],[Reg],[Reg],InstrBlock)
+ -> NatM ([CmmKinded CmmExpr],[Reg],[Reg],InstrBlock)
load_args args [] [] code = return (args, [], [], code)
-- no more regs to use
load_args [] aregs fregs code = return ([], aregs, fregs, code)
-- no more args to push
- load_args ((arg,hint) : rest) aregs fregs code
+ load_args ((CmmKinded arg hint) : rest) aregs fregs code
| isFloatingRep arg_rep =
case fregs of
[] -> push_this_arg
push_this_arg = do
(args',ars,frs,code') <- load_args rest aregs fregs code
- return ((arg,hint):args', ars, frs, code')
+ return ((CmmKinded arg hint):args', ars, frs, code')
push_args [] code = return code
- push_args ((arg,hint):rest) code
+ push_args ((CmmKinded arg hint):rest) code
| isFloatingRep arg_rep = do
(arg_reg, arg_code) <- getSomeReg arg
delta <- getDeltaNat
setDeltaNat (delta-arg_size)
- let code' = code `appOL` toOL [
- MOV arg_rep (OpReg arg_reg) (OpAddr (spRel 0)),
+ let code' = code `appOL` arg_code `appOL` toOL [
SUB wordRep (OpImm (ImmInt arg_size)) (OpReg rsp) ,
- DELTA (delta-arg_size)]
+ DELTA (delta-arg_size),
+ MOV arg_rep (OpReg arg_reg) (OpAddr (spRel 0))]
push_args rest code'
| otherwise = do
stack only immediately prior to the call proper. Sigh.
-}
-genCCall target dest_regs argsAndHints vols = do
+genCCall target dest_regs argsAndHints = do
let
- args = map fst argsAndHints
+ args = map kindlessCmm argsAndHints
argcode_and_vregs <- mapM arg_to_int_vregs args
let
(argcodes, vregss) = unzip argcode_and_vregs
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
)
outOfLineFloatOp mop =
do
- mopExpr <- cmmMakeDynamicReference addImportNat True $
+ dflags <- getDynFlagsNat
+ mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
mkForeignLabel functionName Nothing True
let mopLabelOrExpr = case mopExpr of
CmmLit (CmmLabel lbl) -> Left lbl
return (mopLabelOrExpr, reduce)
where
(reduce, functionName) = case mop of
- MO_F32_Exp -> (True, FSLIT("exp"))
- MO_F32_Log -> (True, FSLIT("log"))
- MO_F32_Sqrt -> (True, FSLIT("sqrt"))
+ MO_F32_Exp -> (True, fsLit "exp")
+ MO_F32_Log -> (True, fsLit "log")
+ MO_F32_Sqrt -> (True, fsLit "sqrt")
- MO_F32_Sin -> (True, FSLIT("sin"))
- MO_F32_Cos -> (True, FSLIT("cos"))
- MO_F32_Tan -> (True, FSLIT("tan"))
+ MO_F32_Sin -> (True, fsLit "sin")
+ MO_F32_Cos -> (True, fsLit "cos")
+ MO_F32_Tan -> (True, fsLit "tan")
- MO_F32_Asin -> (True, FSLIT("asin"))
- MO_F32_Acos -> (True, FSLIT("acos"))
- MO_F32_Atan -> (True, FSLIT("atan"))
+ MO_F32_Asin -> (True, fsLit "asin")
+ MO_F32_Acos -> (True, fsLit "acos")
+ MO_F32_Atan -> (True, fsLit "atan")
- MO_F32_Sinh -> (True, FSLIT("sinh"))
- MO_F32_Cosh -> (True, FSLIT("cosh"))
- MO_F32_Tanh -> (True, FSLIT("tanh"))
+ MO_F32_Sinh -> (True, fsLit "sinh")
+ MO_F32_Cosh -> (True, fsLit "cosh")
+ MO_F32_Tanh -> (True, fsLit "tanh")
- MO_F64_Exp -> (False, FSLIT("exp"))
- MO_F64_Log -> (False, FSLIT("log"))
- MO_F64_Sqrt -> (False, FSLIT("sqrt"))
+ MO_F64_Exp -> (False, fsLit "exp")
+ MO_F64_Log -> (False, fsLit "log")
+ MO_F64_Sqrt -> (False, fsLit "sqrt")
- MO_F64_Sin -> (False, FSLIT("sin"))
- MO_F64_Cos -> (False, FSLIT("cos"))
- MO_F64_Tan -> (False, FSLIT("tan"))
+ MO_F64_Sin -> (False, fsLit "sin")
+ MO_F64_Cos -> (False, fsLit "cos")
+ MO_F64_Tan -> (False, fsLit "tan")
- MO_F64_Asin -> (False, FSLIT("asin"))
- MO_F64_Acos -> (False, FSLIT("acos"))
- MO_F64_Atan -> (False, FSLIT("atan"))
+ MO_F64_Asin -> (False, fsLit "asin")
+ MO_F64_Acos -> (False, fsLit "acos")
+ MO_F64_Atan -> (False, fsLit "atan")
- MO_F64_Sinh -> (False, FSLIT("sinh"))
- MO_F64_Cosh -> (False, FSLIT("cosh"))
- MO_F64_Tanh -> (False, FSLIT("tanh"))
+ MO_F64_Sinh -> (False, fsLit "sinh")
+ MO_F64_Cosh -> (False, fsLit "cosh")
+ MO_F64_Tanh -> (False, fsLit "tanh")
other -> pprPanic "outOfLineFloatOp(sparc) "
(pprCallishMachOp mop)
frame just before ccalling.
-}
-genCCall target dest_regs argsAndHints vols
+
+genCCall (CmmPrim MO_WriteBarrier) _ _
+ = return $ unitOL LWSYNC
+
+genCCall target dest_regs argsAndHints
= ASSERT (not $ any (`elem` [I8,I16]) argReps)
-- we rely on argument promotion in the codeGen
do
(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
initialStackOffset = 8
stackDelta finalStack = roundTo 16 finalStack
#endif
- args = map fst argsAndHints
+ args = map kindlessCmm argsAndHints
argReps = map cmmExprRep args
roundTo a x | x `mod` a == 0 = x
moveResult reduceToF32 =
case dest_regs of
[] -> nilOL
- [(dest, _hint)]
+ [CmmKinded dest _hint]
| reduceToF32 && rep == F32 -> unitOL (FRSP r_dest f1)
| rep == F32 || rep == F64 -> unitOL (MR r_dest f1)
| 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 True $
+ dflags <- getDynFlagsNat
+ mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
mkForeignLabel functionName Nothing True
let mopLabelOrExpr = case mopExpr of
CmmLit (CmmLabel lbl) -> Left lbl
return (mopLabelOrExpr, reduce)
where
(functionName, reduce) = case mop of
- MO_F32_Exp -> (FSLIT("exp"), True)
- MO_F32_Log -> (FSLIT("log"), True)
- MO_F32_Sqrt -> (FSLIT("sqrt"), True)
+ MO_F32_Exp -> (fsLit "exp", True)
+ MO_F32_Log -> (fsLit "log", True)
+ MO_F32_Sqrt -> (fsLit "sqrt", True)
- MO_F32_Sin -> (FSLIT("sin"), True)
- MO_F32_Cos -> (FSLIT("cos"), True)
- MO_F32_Tan -> (FSLIT("tan"), True)
+ MO_F32_Sin -> (fsLit "sin", True)
+ MO_F32_Cos -> (fsLit "cos", True)
+ MO_F32_Tan -> (fsLit "tan", True)
- MO_F32_Asin -> (FSLIT("asin"), True)
- MO_F32_Acos -> (FSLIT("acos"), True)
- MO_F32_Atan -> (FSLIT("atan"), True)
+ MO_F32_Asin -> (fsLit "asin", True)
+ MO_F32_Acos -> (fsLit "acos", True)
+ MO_F32_Atan -> (fsLit "atan", True)
- MO_F32_Sinh -> (FSLIT("sinh"), True)
- MO_F32_Cosh -> (FSLIT("cosh"), True)
- MO_F32_Tanh -> (FSLIT("tanh"), True)
- MO_F32_Pwr -> (FSLIT("pow"), True)
+ MO_F32_Sinh -> (fsLit "sinh", True)
+ MO_F32_Cosh -> (fsLit "cosh", True)
+ MO_F32_Tanh -> (fsLit "tanh", True)
+ MO_F32_Pwr -> (fsLit "pow", True)
- MO_F64_Exp -> (FSLIT("exp"), False)
- MO_F64_Log -> (FSLIT("log"), False)
- MO_F64_Sqrt -> (FSLIT("sqrt"), False)
+ MO_F64_Exp -> (fsLit "exp", False)
+ MO_F64_Log -> (fsLit "log", False)
+ MO_F64_Sqrt -> (fsLit "sqrt", False)
- MO_F64_Sin -> (FSLIT("sin"), False)
- MO_F64_Cos -> (FSLIT("cos"), False)
- MO_F64_Tan -> (FSLIT("tan"), False)
+ MO_F64_Sin -> (fsLit "sin", False)
+ MO_F64_Cos -> (fsLit "cos", False)
+ MO_F64_Tan -> (fsLit "tan", False)
- MO_F64_Asin -> (FSLIT("asin"), False)
- MO_F64_Acos -> (FSLIT("acos"), False)
- MO_F64_Atan -> (FSLIT("atan"), False)
+ MO_F64_Asin -> (fsLit "asin", False)
+ MO_F64_Acos -> (fsLit "acos", False)
+ MO_F64_Atan -> (fsLit "atan", False)
- MO_F64_Sinh -> (FSLIT("sinh"), False)
- MO_F64_Cosh -> (FSLIT("cosh"), False)
- MO_F64_Tanh -> (FSLIT("tanh"), False)
- MO_F64_Pwr -> (FSLIT("pow"), False)
+ MO_F64_Sinh -> (fsLit "sinh", False)
+ MO_F64_Cosh -> (fsLit "cosh", False)
+ MO_F64_Tanh -> (fsLit "tanh", False)
+ MO_F64_Pwr -> (fsLit "pow", False)
other -> pprPanic "genCCall(ppc): unknown callish op"
(pprCallishMachOp other)
= do
(reg,e_code) <- getSomeReg expr
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat False lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let
jumpTable = map jumpTableEntryRel ids
op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
(EAIndex reg wORD_SIZE) (ImmInt 0))
+#if x86_64_TARGET_ARCH
+#if 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
+ -- HACK: On x86_64 binutils<2.17 is only able to generate PC32
+ -- relocations, hence we only get 32-bit offsets in the jump
+ -- table. As these offsets are always negative we need to properly
+ -- sign extend them to 64-bit. This hack should be removed in
+ -- conjunction with the hack in PprMach.hs/pprDataItem once
+ -- binutils 2.17 is standard.
+ code = e_code `appOL` t_code `appOL` toOL [
+ LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
+ MOVSxL I32
+ (OpAddr (AddrBaseIndex (EABaseReg tableReg)
+ (EAIndex reg wORD_SIZE) (ImmInt 0)))
+ (OpReg reg),
+ ADD wordRep (OpReg reg) (OpReg tableReg),
+ JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
+ ]
+#endif
+#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
(reg,e_code) <- getSomeReg expr
tmp <- getNewRegNat I32
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat False lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let
jumpTable = map jumpTableEntryRel ids
]
return code
#else
-genSwitch expr ids = panic "ToDo: genSwitch"
+#error "ToDo: genSwitch"
#endif
jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordRep)
-}
trivialCode rep instr (Just revinstr) (CmmLit lit_a) b
- | not (is64BitLit lit_a) = do
+ | is32BitLit lit_a = do
b_code <- getAnyReg b
let
code dst
-- -----------------------------------------------------------------------------
-- Coercing to/from integer/floating-point...
+-- When going to integer, we truncate (round towards 0).
+
-- @coerce(Int2FP|FP2Int)@ are more complicated integer/float
-- conversions. We have to store temporaries in memory to move
-- between the integer and the floating point register sets.
coerceFP2Int from to x = do
(x_op, x_code) <- getOperand x -- ToDo: could be a safe operand
let
- opc = case from of F32 -> CVTSS2SI; F64 -> CVTSD2SI
+ opc = case from of F32 -> CVTTSS2SIQ; F64 -> CVTTSD2SIQ
code dst = x_code `snocOL` opc x_op dst
-- in
return (Any to code) -- works even if the destination rep is <I32
lbl <- getNewLabelNat
itmp <- getNewRegNat I32
ftmp <- getNewRegNat F64
- dynRef <- cmmMakeDynamicReference addImportNat False lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let
code' dst = code `appOL` maybe_exts `appOL` toOL [