X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FMachCodeGen.hs;h=90ce6b5bf8cca25cfb2bbe5ca2ebaa16d7ecbb96;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=43123ba692915e78b2b2478a09f2086315518f82;hpb=ed3035ea8ca65a7e70fa90288494ffdc2c004505;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/MachCodeGen.hs b/ghc/compiler/nativeGen/MachCodeGen.hs index 43123ba..90ce6b5 100644 --- a/ghc/compiler/nativeGen/MachCodeGen.hs +++ b/ghc/compiler/nativeGen/MachCodeGen.hs @@ -22,6 +22,7 @@ import MachInstrs import MachRegs import NCGMonad import PositionIndependentCode ( cmmMakeDynamicReference, initializePicBase ) +import RegAllocInfo ( mkBranchInstr ) -- Our intermediate code: import PprCmm ( pprExpr ) @@ -735,12 +736,14 @@ getRegister leaf 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) @@ -756,12 +759,14 @@ getRegister (CmmLit (CmmFloat d F64)) | 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) @@ -1109,12 +1114,14 @@ getRegister e@(CmmMachOp mop [x, y]) -- dyadic MachOps -------------------- 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: @@ -1968,13 +1975,16 @@ getRegOrMem e = do 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. @@ -2546,22 +2556,7 @@ genJump 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 @@ -3057,40 +3052,40 @@ genCCall target dest_regs args vols = do 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")