import OrdList
import Pretty
import Outputable
-import qualified Outputable
import FastString
import FastTypes ( isFastTrue )
import Constants ( wORD_SIZE )
getRegister :: CmmExpr -> NatM Register
+getRegister (CmmReg (CmmGlobal PicBaseReg))
+ = do
+ reg <- getPicBaseNat wordRep
+ return (Fixed wordRep reg nilOL)
+
getRegister (CmmReg reg)
= return (Fixed (cmmRegRep reg) (getRegisterReg reg) nilOL)
getRegister tree@(CmmRegOff _ _)
= getRegister (mangleIndexTree tree)
-getRegister CmmPicBaseReg
- = do
- reg <- getPicBaseNat wordRep
- return (Fixed wordRep reg nilOL)
-
-- end of machine-"independent" bit; here we go on the rest...
#if alpha_TARGET_ARCH
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
getNonClobberedOperand :: CmmExpr -> NatM (Operand, InstrBlock)
+#if x86_64_TARGET_ARCH
getNonClobberedOperand (CmmLit lit)
| isSuitableFloatingPointLit lit = do
lbl <- getNewLabelNat
let code = unitOL (LDATA ReadOnlyData [CmmDataLabel lbl,
CmmStaticLit lit])
return (OpAddr (ripRel (ImmCLbl lbl)), code)
+#endif
getNonClobberedOperand (CmmLit lit)
| not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) =
return (OpImm (litToImm lit), nilOL)
-- getOperand: the operand is not required to remain valid across the
-- computation of an arbitrary expression.
getOperand :: CmmExpr -> NatM (Operand, InstrBlock)
+#if x86_64_TARGET_ARCH
getOperand (CmmLit lit)
| isSuitableFloatingPointLit lit = do
lbl <- getNewLabelNat
let code = unitOL (LDATA ReadOnlyData [CmmDataLabel lbl,
CmmStaticLit lit])
return (OpAddr (ripRel (ImmCLbl lbl)), code)
+#endif
getOperand (CmmLit lit)
| not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) = do
return (OpImm (litToImm lit), nilOL)
-- CmmPrim -> ...
CmmForeignCall (CmmLit (CmmLabel lbl)) conv
-> -- ToDo: stdcall arg sizes
- return (unitOL (CALL (Left fn_imm)), conv)
+ return (unitOL (CALL (Left fn_imm) []), conv)
where fn_imm = ImmCLbl lbl
CmmForeignCall expr conv
-> do (dyn_c, dyn_r, dyn_rep) <- get_op expr
ASSERT(dyn_rep == I32)
- return (dyn_c `snocOL` CALL (Right dyn_r), conv)
+ return (dyn_c `snocOL` CALL (Right dyn_r) [], conv)
let push_code = concatOL push_codes
call = callinsns `appOL`
MO_F64_Tanh -> FSLIT("tanh")
MO_F64_Pwr -> FSLIT("pow")
- other -> pprPanic "outOfLineFloatOp" (pprCallishMachOp mop)
-
#endif /* i386_TARGET_ARCH || x86_64_TARGET_ARCH */
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
genCCall target dest_regs args vols = do
-- load up the register arguments
- (stack_args, sse_regs, load_args_code)
- <- load_args args allArgRegs allFPArgRegs 0 nilOL
+ (stack_args, aregs, fregs, load_args_code)
+ <- load_args args allArgRegs allFPArgRegs nilOL
let
+ fp_regs_used = reverse (drop (length fregs) (reverse allFPArgRegs))
+ int_regs_used = reverse (drop (length aregs) (reverse allArgRegs))
+ arg_regs = int_regs_used ++ fp_regs_used
+ -- for annotating the call instruction with
+
+ sse_regs = length fp_regs_used
+
tot_arg_size = arg_size * length stack_args
-- On entry to the called function, %rsp should be aligned
-- CmmPrim -> ...
CmmForeignCall (CmmLit (CmmLabel lbl)) conv
-> -- ToDo: stdcall arg sizes
- return (unitOL (CALL (Left fn_imm)), conv)
+ return (unitOL (CALL (Left fn_imm) arg_regs), conv)
where fn_imm = ImmCLbl lbl
CmmForeignCall expr conv
-> do (dyn_r, dyn_c) <- getSomeReg expr
- return (dyn_c `snocOL` CALL (Right dyn_r), conv)
+ return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
let
-- The x86_64 ABI requires us to set %al to the number of SSE
load_args :: [(CmmExpr,MachHint)]
-> [Reg] -- int regs avail for args
-> [Reg] -- FP regs avail for args
- -> Int -> InstrBlock
- -> NatM ([(CmmExpr,MachHint)],Int,InstrBlock)
- load_args args [] [] sse_regs code = return (args, sse_regs, code)
+ -> InstrBlock
+ -> NatM ([(CmmExpr,MachHint)],[Reg],[Reg],InstrBlock)
+ load_args args [] [] code = return (args, [], [], code)
-- no more regs to use
- load_args [] aregs fregs sse_regs code = return ([],sse_regs,code)
+ load_args [] aregs fregs code = return ([], aregs, fregs, code)
-- no more args to push
- load_args ((arg,hint) : rest) aregs fregs sse_regs code
+ load_args ((arg,hint) : rest) aregs fregs code
| isFloatingRep arg_rep =
case fregs of
[] -> push_this_arg
(r:rs) -> do
arg_code <- getAnyReg arg
- load_args rest aregs rs (sse_regs+1) (code `appOL` arg_code r)
+ load_args rest aregs rs (code `appOL` arg_code r)
| otherwise =
case aregs of
[] -> push_this_arg
(r:rs) -> do
arg_code <- getAnyReg arg
- load_args rest rs fregs sse_regs (code `appOL` arg_code r)
+ load_args rest rs fregs (code `appOL` arg_code r)
where
arg_rep = cmmExprRep arg
push_this_arg = do
- (args',sse',code') <- load_args rest aregs fregs sse_regs code
- return ((arg,hint):args', sse', code')
+ (args',ars,frs,code') <- load_args rest aregs fregs code
+ return ((arg,hint):args', ars, frs, code')
push_args [] code = return code
push_args ((arg,hint):rest) code
-- in
return (Any I32 code)
+#endif
+
+#if i386_TARGET_ARCH
+
+condFltReg cond x y = do
+ CondCode _ cond cond_code <- condFltCode cond x y
+ tmp <- getNewRegNat I8
+ let
+ code dst = cond_code `appOL` toOL [
+ SETCC cond (OpReg tmp),
+ MOVZxL I8 (OpReg tmp) (OpReg dst)
+ ]
+ -- in
+ return (Any I32 code)
+
+#endif
+
+#if x86_64_TARGET_ARCH
+
condFltReg cond x y = do
CondCode _ cond cond_code <- condFltCode cond x y
tmp1 <- getNewRegNat wordRep
]
-- in
return (Any I32 code)
+
#endif
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
projects / ghc-hetmet.git / blobdiff