X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FMachCodeGen.hs;h=d94a906bbddd79223b88f8b40e5c6a922825f8ce;hb=e28dc9b9e45ff351a5e40fd4de9d0fc746540526;hp=c340b9d8d0fa254fdced5cda116996c0d26e2ec7;hpb=2922c9ae951271a60db6fd6b2488f9d8111e442e;p=ghc-hetmet.git diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs index c340b9d..d94a906 100644 --- a/compiler/nativeGen/MachCodeGen.hs +++ b/compiler/nativeGen/MachCodeGen.hs @@ -25,12 +25,11 @@ module MachCodeGen ( cmmTopCodeGen, InstrBlock ) where #include "MachDeps.h" -- NCG stuff: -import MachInstrs -import MachRegs +import Instrs +import Regs import NCGMonad import PositionIndependentCode import RegAllocInfo ( mkBranchInstr, mkRegRegMoveInstr ) -import MachRegs import PprMach -- Our intermediate code: @@ -41,6 +40,7 @@ import CLabel import ClosureInfo ( C_SRT(..) ) -- The rest: +import BasicTypes import StaticFlags ( opt_PIC ) import ForeignCall ( CCallConv(..) ) import OrdList @@ -371,6 +371,26 @@ iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)]) r_dst_lo +-- Addition of II64 +iselExpr64 (CmmMachOp (MO_Add width) [e1, e2]) + = do ChildCode64 code1 r1_lo <- iselExpr64 e1 + let r1_hi = getHiVRegFromLo r1_lo + + ChildCode64 code2 r2_lo <- iselExpr64 e2 + let r2_hi = getHiVRegFromLo r2_lo + + r_dst_lo <- getNewRegNat II32 + let r_dst_hi = getHiVRegFromLo r_dst_lo + + let code = code1 + `appOL` code2 + `appOL` toOL + [ ADD False False r1_lo (RIReg r2_lo) r_dst_lo + , ADD True False r1_hi (RIReg r2_hi) r_dst_hi ] + + return $ ChildCode64 code r_dst_lo + + iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) | isWord64 ty = do r_dst_lo <- getNewRegNat II32 let r_dst_hi = getHiVRegFromLo r_dst_lo @@ -383,6 +403,23 @@ iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) | isWord64 ty = do ChildCode64 (toOL [mov_hi, mov_lo]) r_dst_lo ) +-- Convert something into II64 +iselExpr64 (CmmMachOp (MO_UU_Conv _ W64) [expr]) + = do + r_dst_lo <- getNewRegNat II32 + let r_dst_hi = getHiVRegFromLo r_dst_lo + + -- compute expr and load it into r_dst_lo + (a_reg, a_code) <- getSomeReg expr + + let code = a_code + `appOL` toOL + [ mkRegRegMoveInstr g0 r_dst_hi -- clear high 32 bits + , mkRegRegMoveInstr a_reg r_dst_lo ] + + return $ ChildCode64 code r_dst_lo + + iselExpr64 expr = pprPanic "iselExpr64(sparc)" (ppr expr) @@ -3372,7 +3409,7 @@ outOfLineFloatOp mop res args code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) return (code1 `appOL` code2) where - lbl = mkForeignLabel fn Nothing False + lbl = mkForeignLabel fn Nothing False IsFunction fn = case mop of MO_F32_Sqrt -> fsLit "sqrtf" @@ -3567,8 +3604,9 @@ genCCall target dest_regs args = do (arg_op, arg_code) <- getOperand arg delta <- getDeltaNat setDeltaNat (delta-arg_size) - let code' = code `appOL` toOL [PUSH II64 arg_op, - DELTA (delta-arg_size)] + let code' = code `appOL` arg_code `appOL` toOL [ + PUSH II64 arg_op, + DELTA (delta-arg_size)] push_args rest code' where arg_rep = cmmExprType arg @@ -3615,6 +3653,16 @@ genCCall -} + +-- On SPARC under TSO (Total Store Ordering), writes earlier in the instruction stream +-- are guaranteed to take place before writes afterwards (unlike on PowerPC). +-- Ref: Section 8.4 of the SPARC V9 Architecture manual. +-- +-- In the SPARC case we don't need a barrier. +-- +genCCall (CmmPrim (MO_WriteBarrier)) _ _ + = do return nilOL + genCCall target dest_regs argsAndHints = do -- strip hints from the arg regs @@ -3641,7 +3689,7 @@ genCCall target dest_regs argsAndHints return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False) CmmPrim mop - -> do (res, reduce) <- outOfLineFloatOp mop + -> do res <- outOfLineFloatOp mop lblOrMopExpr <- case res of Left lbl -> do return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False)) @@ -3649,9 +3697,8 @@ genCCall target dest_regs argsAndHints Right mopExpr -> do (dyn_c, [dyn_r]) <- arg_to_int_vregs mopExpr return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False) - if reduce - then panic ("genCCall(sparc): can not reduce mach op " ++ show mop) - else return lblOrMopExpr + + return lblOrMopExpr let argcode = concatOL argcodes @@ -3787,62 +3834,65 @@ assign_code [CmmHinted dest _hint] -- | Generate a call to implement an out-of-line floating point operation outOfLineFloatOp :: CallishMachOp - -> NatM ( Either CLabel CmmExpr - , Bool) + -> NatM (Either CLabel CmmExpr) outOfLineFloatOp mop - = do let (reduce, functionName) + = do let functionName = outOfLineFloatOp_table mop dflags <- getDynFlagsNat mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference - $ mkForeignLabel functionName Nothing True + $ mkForeignLabel functionName Nothing True IsFunction let mopLabelOrExpr = case mopExpr of CmmLit (CmmLabel lbl) -> Left lbl _ -> Right mopExpr - return (mopLabelOrExpr, reduce) + return mopLabelOrExpr +-- | Decide what C function to use to implement a CallishMachOp +-- outOfLineFloatOp_table :: CallishMachOp - -> (Bool, FastString) + -> FastString outOfLineFloatOp_table mop = case mop of - MO_F32_Exp -> (True, fsLit "exp") - MO_F32_Log -> (True, fsLit "log") - MO_F32_Sqrt -> (True, fsLit "sqrt") + MO_F32_Exp -> fsLit "expf" + MO_F32_Log -> fsLit "logf" + MO_F32_Sqrt -> fsLit "sqrtf" + MO_F32_Pwr -> fsLit "powf" - MO_F32_Sin -> (True, fsLit "sin") - MO_F32_Cos -> (True, fsLit "cos") - MO_F32_Tan -> (True, fsLit "tan") + MO_F32_Sin -> fsLit "sinf" + MO_F32_Cos -> fsLit "cosf" + MO_F32_Tan -> fsLit "tanf" - MO_F32_Asin -> (True, fsLit "asin") - MO_F32_Acos -> (True, fsLit "acos") - MO_F32_Atan -> (True, fsLit "atan") + MO_F32_Asin -> fsLit "asinf" + MO_F32_Acos -> fsLit "acosf" + MO_F32_Atan -> fsLit "atanf" - MO_F32_Sinh -> (True, fsLit "sinh") - MO_F32_Cosh -> (True, fsLit "cosh") - MO_F32_Tanh -> (True, fsLit "tanh") + MO_F32_Sinh -> fsLit "sinhf" + MO_F32_Cosh -> fsLit "coshf" + MO_F32_Tanh -> fsLit "tanhf" - MO_F64_Exp -> (False, fsLit "exp") - MO_F64_Log -> (False, fsLit "log") - MO_F64_Sqrt -> (False, fsLit "sqrt") + MO_F64_Exp -> fsLit "exp" + MO_F64_Log -> fsLit "log" + MO_F64_Sqrt -> fsLit "sqrt" + MO_F64_Pwr -> fsLit "pow" - MO_F64_Sin -> (False, fsLit "sin") - MO_F64_Cos -> (False, fsLit "cos") - MO_F64_Tan -> (False, fsLit "tan") + MO_F64_Sin -> fsLit "sin" + MO_F64_Cos -> fsLit "cos" + MO_F64_Tan -> fsLit "tan" - MO_F64_Asin -> (False, fsLit "asin") - MO_F64_Acos -> (False, fsLit "acos") - MO_F64_Atan -> (False, fsLit "atan") + MO_F64_Asin -> fsLit "asin" + MO_F64_Acos -> fsLit "acos" + MO_F64_Atan -> fsLit "atan" - MO_F64_Sinh -> (False, fsLit "sinh") - MO_F64_Cosh -> (False, fsLit "cosh") - MO_F64_Tanh -> (False, fsLit "tanh") + MO_F64_Sinh -> fsLit "sinh" + MO_F64_Cosh -> fsLit "cosh" + MO_F64_Tanh -> fsLit "tanh" other -> pprPanic "outOfLineFloatOp(sparc): Unknown callish mach op " (pprCallishMachOp mop) @@ -4063,7 +4113,7 @@ genCCall target dest_regs argsAndHints do dflags <- getDynFlagsNat mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $ - mkForeignLabel functionName Nothing True + mkForeignLabel functionName Nothing True IsFunction let mopLabelOrExpr = case mopExpr of CmmLit (CmmLabel lbl) -> Left lbl _ -> Right mopExpr @@ -4261,8 +4311,8 @@ genSwitch expr ids , SLL e_reg (RIImm $ ImmInt 2) offset_reg -- load and jump to the destination - , LD II32 (AddrRegReg base_reg offset_reg) dst - , JMP (AddrRegImm dst (ImmInt 0)) + , LD II32 (AddrRegReg base_reg offset_reg) dst + , JMP_TBL (AddrRegImm dst (ImmInt 0)) [i | Just i <- ids] , NOP ] #else @@ -5140,7 +5190,7 @@ coerceFP2Int fromRep toRep x = do -- We (allegedly) put the first six C-call arguments in registers; -- where do we start putting the rest of them? --- Moved from MachInstrs (SDM): +-- Moved from Instrs (SDM): #if alpha_TARGET_ARCH || sparc_TARGET_ARCH eXTRA_STK_ARGS_HERE :: Int