import RegAllocInfo ( mkBranchInstr )
-- Our intermediate code:
+import BlockId
import PprCmm ( pprExpr )
import Cmm
import MachOp
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
--------------------
add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
add_code rep x (CmmLit (CmmInt y _))
- | not (is64BitInteger y) = add_int rep x y
+ | is32BitInteger 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 _))
- | not (is64BitInteger (-y)) = add_int rep x (-y)
+ | is32BitInteger (-y) = add_int rep x (-y)
sub_code rep x y = trivialCode rep (SUB rep) Nothing x y
-- our three-operand add instruction:
where
isBigLit (CmmInt i I64) = i < 0 || i > 0xffffffff
isBigLit _ = False
- -- note1: not the same as is64BitLit, because that checks for
+ -- note1: not the same as (not.is32BitLit), because that checks for
-- signed literals that fit in 32 bits, but we want unsigned
-- literals here.
-- note2: all labels are small, because we're assuming the
-- This is all just ridiculous, since it carefully undoes
-- what mangleIndexTree has just done.
getAmode (CmmMachOp (MO_Sub rep) [x, CmmLit lit@(CmmInt i _)])
- | not (is64BitLit lit)
+ | is32BitLit lit
-- ASSERT(rep == I32)???
= do (x_reg, x_code) <- getSomeReg x
let off = ImmInt (-(fromInteger i))
return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit@(CmmInt i _)])
- | not (is64BitLit lit)
+ | is32BitLit lit
-- ASSERT(rep == I32)???
= do (x_reg, x_code) <- getSomeReg x
let off = ImmInt (fromInteger i)
[CmmMachOp (MO_Shl _) [y, CmmLit (CmmInt shift _)],
CmmLit (CmmInt offset _)]])
| shift == 0 || shift == 1 || shift == 2 || shift == 3
- && not (is64BitInteger offset)
+ && is32BitInteger offset
= x86_complex_amode x y shift offset
getAmode (CmmMachOp (MO_Add rep) [x,y])
= x86_complex_amode x y 0 0
-getAmode (CmmLit lit) | not (is64BitLit lit)
+getAmode (CmmLit lit) | is32BitLit lit
= return (Amode (ImmAddr (litToImm lit) 0) nilOL)
getAmode expr = do
return (OpAddr (ripRel (ImmCLbl lbl)), code)
#endif
getNonClobberedOperand (CmmLit lit)
- | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) =
+ | is32BitLit lit && not (isFloatingRep (cmmLitRep lit)) =
return (OpImm (litToImm lit), nilOL)
getNonClobberedOperand (CmmLoad mem pk)
| IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
return (OpAddr (ripRel (ImmCLbl lbl)), code)
#endif
getOperand (CmmLit lit)
- | not (is64BitLit lit) && not (isFloatingRep (cmmLitRep lit)) = do
+ | is32BitLit lit && not (isFloatingRep (cmmLitRep lit)) = do
return (OpImm (litToImm lit), nilOL)
getOperand (CmmLoad mem pk)
| IF_ARCH_i386(not (isFloatingRep pk) && pk /= I64, True) = do
isOperand :: CmmExpr -> Bool
isOperand (CmmLoad _ _) = True
-isOperand (CmmLit lit) = not (is64BitLit lit)
+isOperand (CmmLit lit) = is32BitLit lit
|| isSuitableFloatingPointLit lit
isOperand _ = False
return (OpReg reg, code)
#if x86_64_TARGET_ARCH
-is64BitLit (CmmInt i I64) = is64BitInteger i
+is32BitLit (CmmInt i I64) = is32BitInteger 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
+is32BitLit x = False
#endif
-is64BitInteger :: Integer -> Bool
-is64BitInteger i = i64 > 0x7fffffff || i64 < -0x80000000
+is32BitInteger :: Integer -> Bool
+is32BitInteger i = i64 <= 0x7fffffff && i64 >= -0x80000000
where i64 = fromIntegral i :: Int64
-- a CmmInt is intended to be truncated to the appropriate
-- number of bits, so here we truncate it to Int64. This is
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-- memory vs immediate
-condIntCode cond (CmmLoad x pk) (CmmLit lit) | not (is64BitLit lit) = do
+condIntCode cond (CmmLoad x pk) (CmmLit lit) | is32BitLit lit = do
Amode x_addr x_code <- getAmode x
let
imm = litToImm lit
-- address.
assignMem_IntCode pk addr (CmmMachOp op [CmmLoad addr2 _,
CmmLit (CmmInt i _)])
- | addr == addr2, pk /= I64 || not (is64BitInteger i),
+ | addr == addr2, pk /= I64 || is32BitInteger i,
Just instr <- check op
= do Amode amode code_addr <- getAmode addr
let code = code_addr `snocOL`
return code
where
get_op_RI :: CmmExpr -> NatM (InstrBlock,Operand) -- code, operator
- get_op_RI (CmmLit lit) | not (is64BitLit lit)
+ get_op_RI (CmmLit lit) | is32BitLit lit
= return (nilOL, OpImm (litToImm lit))
get_op_RI op
= do (reg,code) <- getNonClobberedReg op
-- we keep it this long in order to prevent earlier optimisations.
-- we only cope with a single result for foreign calls
-genCCall (CmmPrim op) [CmmHinted 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 [CmmHinted 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 . hintlessCmm) (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 [CmmHinted 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 :: (CmmHinted CmmExpr){-current argument-}
+ push_arg :: (CmmKinded CmmExpr){-current argument-}
-> NatM InstrBlock -- code
- push_arg (CmmHinted 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 [CmmHinted 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 [CmmHinted 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
-- we keep it this long in order to prevent earlier optimisations.
-genCCall (CmmPrim op) [CmmHinted 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 [CmmHinted 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 :: [CmmHinted CmmExpr]
+ load_args :: [CmmKinded CmmExpr]
-> [Reg] -- int regs avail for args
-> [Reg] -- FP regs avail for args
-> InstrBlock
- -> NatM ([CmmHinted CmmExpr],[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 ((CmmHinted 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 ((CmmHinted arg hint):args', ars, frs, code')
+ return ((CmmKinded arg hint):args', ars, frs, code')
push_args [] code = return code
- push_args ((CmmHinted 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 hintlessCmm argsAndHints
+ args = map kindlessCmm argsAndHints
argcode_and_vregs <- mapM arg_to_int_vregs args
let
(argcodes, vregss) = unzip argcode_and_vregs
initialStackOffset = 8
stackDelta finalStack = roundTo 16 finalStack
#endif
- args = map hintlessCmm argsAndHints
+ args = map kindlessCmm argsAndHints
argReps = map cmmExprRep args
roundTo a x | x `mod` a == 0 = x
moveResult reduceToF32 =
case dest_regs of
[] -> nilOL
- [CmmHinted 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,
-}
trivialCode rep instr (Just revinstr) (CmmLit lit_a) b
- | not (is64BitLit lit_a) = do
+ | is32BitLit lit_a = do
b_code <- getAnyReg b
let
code dst
projects / ghc-hetmet.git / blobdiff