import Pretty
import Outputable
import FastString
-import FastTypes ( isFastTrue )
+import FastBool ( isFastTrue )
import Constants ( wORD_SIZE )
-#ifdef DEBUG
-import Outputable ( assertPanic )
-import Debug.Trace ( trace )
-#endif
import Debug.Trace ( trace )
import Control.Monad ( mapAndUnzipM )
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
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
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 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
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)
= 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)
-- 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 = 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
where
- actuallyInlineFloatOp rep instr [(x,_)]
+ actuallyInlineFloatOp rep instr [CmmKinded x _]
= do res <- trivialUFCode rep instr x
any <- anyReg res
return (any (getRegisterReg (CmmLocal r)))
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
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)]
| 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 localRegRep res == F64
then
- stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn)
+ stmtToInstrs (CmmCall target [CmmKinded res FloatHint] args CmmUnsafe CmmMayReturn)
else do
uq <- getUniqueNat
let
tmp = LocalReg uq F64 GCKindNonPtr
-- in
- code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
+ 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 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 */
-- write barrier compiles to no code on x86/x86-64;
-- we keep it this long in order to prevent earlier optimisations.
-genCCall (CmmPrim op) [(r,_)] args =
+
+genCCall (CmmPrim op) [CmmKinded r _] args =
outOfLineFloatOp op r args
genCCall target dest_regs args = do
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))
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
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
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)
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,
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)
]
return code
#else
-genSwitch expr ids = panic "ToDo: genSwitch"
+#error "ToDo: genSwitch"
#endif
jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordRep)
projects / ghc-hetmet.git / blobdiff