module X86.CodeGen (
cmmTopCodeGen,
+ generateJumpTableForInstr,
InstrBlock
)
import BasicTypes
import BlockId
import PprCmm ( pprExpr )
-import Cmm
+import OldCmm
+import OldPprCmm
import CLabel
import ClosureInfo ( C_SRT(..) )
import Pretty
import qualified Outputable as O
import Outputable
+import Unique
import FastString
import FastBool ( isFastTrue )
import Constants ( wORD_SIZE )
-> RawCmmTop
-> NatM [NatCmmTop Instr]
-cmmTopCodeGen dynflags
- (CmmProc info lab params (ListGraph blocks)) = do
+cmmTopCodeGen dynflags (CmmProc info lab (ListGraph blocks)) = do
(nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
picBaseMb <- getPicBaseMaybeNat
- let proc = CmmProc info lab params (ListGraph $ concat nat_blocks)
+ let proc = CmmProc info lab (ListGraph $ concat nat_blocks)
tops = proc : concat statics
os = platformOS $ targetPlatform dynflags
else RegVirtual (mkVirtualReg u sz)
getRegisterReg _ (CmmGlobal mid)
- = case get_GlobalReg_reg_or_addr mid of
- Left reg -> RegReal $ reg
- _other -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
- -- By this stage, the only MagicIds remaining should be the
- -- ones which map to a real machine register on this
- -- platform. Hence ...
+ = case globalRegMaybe mid of
+ Just reg -> RegReal $ reg
+ Nothing -> pprPanic "getRegisterReg-memory" (ppr $ CmmGlobal mid)
+ -- By this stage, the only MagicIds remaining should be the
+ -- ones which map to a real machine register on this
+ -- platform. Hence ...
-- | Memory addressing modes passed up the tree.
-- | Convert a BlockId to some CmmStatic data
jumpTableEntry :: Maybe BlockId -> CmmStatic
jumpTableEntry Nothing = CmmStaticLit (CmmInt 0 wordWidth)
-jumpTableEntry (Just (BlockId id)) = CmmStaticLit (CmmLabel blockLabel)
- where blockLabel = mkAsmTempLabel id
+jumpTableEntry (Just blockid) = CmmStaticLit (CmmLabel blockLabel)
+ where blockLabel = mkAsmTempLabel (getUnique blockid)
-- -----------------------------------------------------------------------------
size | not use_sse2 && isFloatSize sz = FF80
| otherwise = sz
--
- return (Fixed sz (getRegisterReg use_sse2 reg) nilOL)
+ return (Fixed size (getRegisterReg use_sse2 reg) nilOL)
getRegister tree@(CmmRegOff _ _)
| sse2 -> coerceFP2FP W64 x
| otherwise -> conversionNop FF80 x
- MO_FF_Conv W64 W32
- | sse2 -> coerceFP2FP W32 x
- | otherwise -> conversionNop FF80 x
+ MO_FF_Conv W64 W32 -> coerceFP2FP W32 x
MO_FS_Conv from to -> coerceFP2Int from to x
MO_SF_Conv from to -> coerceInt2FP from to 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 _)])
+getAmode (CmmMachOp (MO_Add rep) [x, CmmLit lit])
| is32BitLit lit
-- ASSERT(rep == II32)???
= do (x_reg, x_code) <- getSomeReg x
- let off = ImmInt (fromInteger i)
+ let off = litToImm lit
return (Amode (AddrBaseIndex (EABaseReg x_reg) EAIndexNone off) x_code)
-- Turn (lit1 << n + lit2) into (lit2 + lit1 << n) so it will be
return (unitOL (CALL (Left fn_imm) []), conv)
where fn_imm = ImmCLbl lbl
CmmCallee expr conv
- -> do { (dyn_c, dyn_r) <- get_op expr
+ -> do { (dyn_r, dyn_c) <- getSomeReg expr
; ASSERT( isWord32 (cmmExprType expr) )
return (dyn_c `snocOL` CALL (Right dyn_r) [], conv) }
| otherwise
#endif
= concatOL push_codes
+
+ -- Deallocate parameters after call for ccall;
+ -- but not for stdcall (callee does it)
+ --
+ -- We have to pop any stack padding we added
+ -- on Darwin even if we are doing stdcall, though (#5052)
+ pop_size | cconv /= StdCallConv = tot_arg_size
+ | otherwise
+#if darwin_TARGET_OS
+ = arg_pad_size
+#else
+ = 0
+#endif
+
call = callinsns `appOL`
toOL (
- -- Deallocate parameters after call for ccall;
- -- but not for stdcall (callee does it)
- (if cconv == StdCallConv || tot_arg_size==0 then [] else
- [ADD II32 (OpImm (ImmInt tot_arg_size)) (OpReg esp)])
+ (if pop_size==0 then [] else
+ [ADD II32 (OpImm (ImmInt pop_size)) (OpReg esp)])
++
[DELTA (delta + tot_arg_size)]
)
DELTA (delta-8)]
)
- | otherwise = do
- (code, reg) <- get_op arg
+ | isFloatType arg_ty = do
+ (reg, code) <- getSomeReg arg
delta <- getDeltaNat
- let size = arg_size arg_ty -- Byte size
setDeltaNat (delta-size)
- if (isFloatType arg_ty)
- then return (code `appOL`
+ return (code `appOL`
toOL [SUB II32 (OpImm (ImmInt size)) (OpReg esp),
DELTA (delta-size),
let addr = AddrBaseIndex (EABaseReg esp)
else GST size reg addr
]
)
- else return (code `snocOL`
- PUSH II32 (OpReg reg) `snocOL`
- DELTA (delta-size)
- )
+
+ | otherwise = do
+ (operand, code) <- getOperand arg
+ delta <- getDeltaNat
+ setDeltaNat (delta-size)
+ return (code `snocOL`
+ PUSH II32 operand `snocOL`
+ DELTA (delta-size))
+
where
arg_ty = cmmExprType arg
-
- ------------
- get_op :: CmmExpr -> NatM (InstrBlock, Reg) -- code, reg
- get_op op = do
- (reg,code) <- getSomeReg op
- return (code, reg)
+ size = arg_size arg_ty -- Byte size
#elif x86_64_TARGET_ARCH
dflags <- getDynFlagsNat
dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
- let
- jumpTable = map jumpTableEntryRel ids
-
- jumpTableEntryRel Nothing
- = CmmStaticLit (CmmInt 0 wordWidth)
- jumpTableEntryRel (Just (BlockId id))
- = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
- where blockLabel = mkAsmTempLabel id
-
- op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
+ let op = OpAddr (AddrBaseIndex (EABaseReg tableReg)
(EAIndex reg wORD_SIZE) (ImmInt 0))
#if x86_64_TARGET_ARCH
code = e_code `appOL` t_code `appOL` toOL [
ADD (intSize wordWidth) op (OpReg tableReg),
- JMP_TBL (OpReg tableReg) [ id | Just id <- ids ],
- LDATA Text (CmmDataLabel lbl : jumpTable)
+ JMP_TBL (OpReg tableReg) ids Text lbl
]
#else
-- HACK: On x86_64 binutils<2.17 is only able to generate PC32
-- conjunction with the hack in PprMach.hs/pprDataItem once
-- binutils 2.17 is standard.
code = e_code `appOL` t_code `appOL` toOL [
- LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
MOVSxL II32
(OpAddr (AddrBaseIndex (EABaseReg tableReg)
(EAIndex reg wORD_SIZE) (ImmInt 0)))
(OpReg reg),
ADD (intSize wordWidth) (OpReg reg) (OpReg tableReg),
- JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
+ JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl
]
#endif
#else
code = e_code `appOL` t_code `appOL` toOL [
- LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
ADD (intSize wordWidth) op (OpReg tableReg),
- JMP_TBL (OpReg tableReg) [ id | Just id <- ids ]
+ JMP_TBL (OpReg tableReg) ids ReadOnlyData lbl
]
#endif
return code
(reg,e_code) <- getSomeReg expr
lbl <- getNewLabelNat
let
- jumpTable = map jumpTableEntry ids
op = OpAddr (AddrBaseIndex EABaseNone (EAIndex reg wORD_SIZE) (ImmCLbl lbl))
code = e_code `appOL` toOL [
- LDATA ReadOnlyData (CmmDataLabel lbl : jumpTable),
- JMP_TBL op [ id | Just id <- ids ]
+ JMP_TBL op ids ReadOnlyData lbl
]
-- in
return code
+generateJumpTableForInstr :: Instr -> Maybe (NatCmmTop Instr)
+generateJumpTableForInstr (JMP_TBL _ ids section lbl) = Just (createJumpTable ids section lbl)
+generateJumpTableForInstr _ = Nothing
+
+createJumpTable ids section lbl
+ = let jumpTable
+ | opt_PIC =
+ let jumpTableEntryRel Nothing
+ = CmmStaticLit (CmmInt 0 wordWidth)
+ jumpTableEntryRel (Just blockid)
+ = CmmStaticLit (CmmLabelDiffOff blockLabel lbl 0)
+ where blockLabel = mkAsmTempLabel (getUnique blockid)
+ in map jumpTableEntryRel ids
+ | otherwise = map jumpTableEntry ids
+ in CmmData section (CmmDataLabel lbl : jumpTable)
-- -----------------------------------------------------------------------------
-- 'condIntReg' and 'condFltReg': condition codes into registers
--------------------------------------------------------------------------------
coerceFP2FP :: Width -> CmmExpr -> NatM Register
coerceFP2FP to x = do
+ use_sse2 <- sse2Enabled
(x_reg, x_code) <- getSomeReg x
let
- opc = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD
+ opc | use_sse2 = case to of W32 -> CVTSD2SS; W64 -> CVTSS2SD
+ | otherwise = GDTOF
code dst = x_code `snocOL` opc x_reg dst
-- in
- return (Any (floatSize to) code)
+ return (Any (if use_sse2 then floatSize to else FF80) code)
--------------------------------------------------------------------------------
projects / ghc-hetmet.git / blobdiff