import MachRegs
import NCGMonad
import PositionIndependentCode ( cmmMakeDynamicReference, initializePicBase )
+import RegAllocInfo ( mkBranchInstr )
-- Our intermediate code:
import PprCmm ( pprExpr )
getRegister (CmmLit (CmmFloat f F32)) = do
lbl <- getNewLabelNat
- let code dst = toOL [
+ dynRef <- cmmMakeDynamicReference addImportNat False lbl
+ Amode addr addr_code <- getAmode dynRef
+ let code dst =
LDATA ReadOnlyData
[CmmDataLabel lbl,
- CmmStaticLit (CmmFloat f F32)],
- GLD F32 (ImmAddr (ImmCLbl lbl) 0) dst
- ]
+ CmmStaticLit (CmmFloat f F32)]
+ `consOL` (addr_code `snocOL`
+ GLD F32 addr dst)
-- in
return (Any F32 code)
| otherwise = do
lbl <- getNewLabelNat
- let code dst = toOL [
+ dynRef <- cmmMakeDynamicReference addImportNat False lbl
+ Amode addr addr_code <- getAmode dynRef
+ let code dst =
LDATA ReadOnlyData
[CmmDataLabel lbl,
- CmmStaticLit (CmmFloat d F64)],
- GLD F64 (ImmAddr (ImmCLbl lbl) 0) dst
- ]
+ CmmStaticLit (CmmFloat d F64)]
+ `consOL` (addr_code `snocOL`
+ GLD F64 addr dst)
-- in
return (Any F64 code)
--------------------
add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
- add_code rep x (CmmLit (CmmInt y _)) = add_int rep x y
+ add_code rep x (CmmLit (CmmInt y _))
+ | not (is64BitInteger 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 _)) = add_int rep x (-y)
+ sub_code rep x (CmmLit (CmmInt y _))
+ | not (is64BitInteger (-y)) = add_int rep x (-y)
sub_code rep x y = trivialCode rep (SUB rep) Nothing x y
-- our three-operand add instruction:
return (OpReg reg, code)
#if x86_64_TARGET_ARCH
-is64BitLit (CmmInt i I64) = i > 0x7fffffff || i < -0x80000000
+is64BitLit (CmmInt i I64) = is64BitInteger 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
#endif
+is64BitInteger :: Integer -> Bool
+is64BitInteger i = i > 0x7fffffff || i < -0x80000000
+
-- -----------------------------------------------------------------------------
-- The 'CondCode' type: Condition codes passed up the tree.
genBranch :: BlockId -> NatM InstrBlock
-#if alpha_TARGET_ARCH
-genBranch id = return (unitOL (BR id))
-#endif
-
-#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-genBranch id = return (unitOL (JXX ALWAYS id))
-#endif
-
-#if sparc_TARGET_ARCH
-genBranch (BlockId id) = return (toOL [BI ALWAYS False (ImmCLbl (mkAsmTempLabel id)), NOP])
-#endif
-
-#if powerpc_TARGET_ARCH
-genBranch id = return (unitOL (BCC ALWAYS id))
-#endif
-
+genBranch = return . toOL . mkBranchInstr
-- -----------------------------------------------------------------------------
-- Conditional jumps
outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
-> Maybe [GlobalReg] -> NatM InstrBlock
outOfLineFloatOp mop res args vols
- | cmmRegRep res == F64
- = stmtToInstrs (CmmCall target [(res,FloatHint)] args vols)
-
- | otherwise
- = do uq <- getUniqueNat
- let
- tmp = CmmLocal (LocalReg uq F64)
- -- in
- code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] (map promote args) vols)
- code2 <- stmtToInstrs (CmmAssign res (demote (CmmReg tmp)))
- return (code1 `appOL` code2)
+ = do
+ targetExpr <- cmmMakeDynamicReference addImportNat True lbl
+ let target = CmmForeignCall targetExpr CCallConv
+
+ if cmmRegRep res == F64
+ then
+ stmtToInstrs (CmmCall target [(res,FloatHint)] args vols)
+ else do
+ uq <- getUniqueNat
+ let
+ tmp = CmmLocal (LocalReg uq F64)
+ -- in
+ code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args vols)
+ code2 <- stmtToInstrs (CmmAssign res (CmmReg tmp))
+ return (code1 `appOL` code2)
where
- promote (x,hint) = (CmmMachOp (MO_S_Conv F32 F64) [x], hint)
- demote x = CmmMachOp (MO_S_Conv F64 F32) [x]
-
- target = CmmForeignCall (CmmLit lbl) CCallConv
- lbl = CmmLabel (mkForeignLabel fn Nothing False)
+ lbl = mkForeignLabel fn Nothing True
fn = case mop of
- MO_F32_Sqrt -> FSLIT("sqrt")
- MO_F32_Sin -> FSLIT("sin")
- MO_F32_Cos -> FSLIT("cos")
- MO_F32_Tan -> FSLIT("tan")
- MO_F32_Exp -> FSLIT("exp")
- MO_F32_Log -> FSLIT("log")
-
- MO_F32_Asin -> FSLIT("asin")
- MO_F32_Acos -> FSLIT("acos")
- MO_F32_Atan -> FSLIT("atan")
-
- MO_F32_Sinh -> FSLIT("sinh")
- MO_F32_Cosh -> FSLIT("cosh")
- MO_F32_Tanh -> FSLIT("tanh")
- MO_F32_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")