#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:
import ClosureInfo ( C_SRT(..) )
-- The rest:
+import BasicTypes
import StaticFlags ( opt_PIC )
import ForeignCall ( CCallConv(..) )
import OrdList
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
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)
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"
(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
-}
+
+-- 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
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))
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
-- | 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)
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
, 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
-- 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