-- (c) the #if blah_TARGET_ARCH} things, the
-- structure should not be too overwhelming.
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+
module MachCodeGen ( cmmTopCodeGen, InstrBlock ) where
#include "HsVersions.h"
import Cmm
import MachOp
import CLabel
+import ClosureInfo ( C_SRT(..) )
-- The rest:
import StaticFlags ( opt_PIC )
import Outputable ( assertPanic )
import Debug.Trace ( trace )
#endif
+import Debug.Trace ( trace )
import Control.Monad ( mapAndUnzipM )
import Data.Maybe ( fromJust )
type InstrBlock = OrdList Instr
-cmmTopCodeGen :: CmmTop -> NatM [NatCmmTop]
+cmmTopCodeGen :: RawCmmTop -> NatM [NatCmmTop]
cmmTopCodeGen (CmmProc info lab params blocks) = do
(nat_blocks,statics) <- mapAndUnzipM basicBlockCodeGen blocks
picBaseMb <- getPicBaseMaybeNat
| otherwise -> assignMem_IntCode kind addr src
where kind = cmmExprRep src
- CmmCall target result_regs args vols
- -> genCCall target result_regs args vols
+ CmmCall target result_regs args _ _
+ -> genCCall target result_regs args
CmmBranch id -> genBranch id
CmmCondBranch arg id -> genCondJump id arg
return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
-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 I32
rlo
)
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
+iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _)))
= return (ChildCode64 nilOL (mkVReg vu I32))
-- we handle addition, but rather badly
-- in
return (ChildCode64 code rlo)
+iselExpr64 (CmmMachOp (MO_U_Conv _ I64) [expr]) = do
+ fn <- getAnyReg expr
+ r_dst_lo <- getNewRegNat I32
+ let r_dst_hi = getHiVRegFromLo r_dst_lo
+ code = fn r_dst_lo
+ return (
+ ChildCode64 (code `snocOL`
+ MOV I32 (OpImm (ImmInt 0)) (OpReg r_dst_hi))
+ r_dst_lo
+ )
+
iselExpr64 expr
= pprPanic "iselExpr64(i386)" (ppr expr)
-- in
return (vcode `appOL` addr_code `snocOL` mov_lo `snocOL` mov_hi)
-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 I32
return $ ChildCode64 (addr_code `snocOL` mov_lo `snocOL` mov_hi)
rlo
-iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64)))
+iselExpr64 (CmmReg (CmmLocal (LocalReg vu I64 _)))
= return (ChildCode64 nilOL (mkVReg vu I32))
iselExpr64 (CmmLit (CmmInt i _)) = do
-- in
return (ChildCode64 code rlo)
+iselExpr64 (CmmMachOp (MO_U_Conv I32 I64) [expr]) = do
+ (expr_reg,expr_code) <- getSomeReg expr
+ (rlo, rhi) <- getNewRegPairNat I32
+ let mov_hi = LI rhi (ImmInt 0)
+ mov_lo = MR rlo expr_reg
+ return $ ChildCode64 (expr_code `snocOL` mov_lo `snocOL` mov_hi)
+ rlo
iselExpr64 expr
= pprPanic "iselExpr64(powerpc)" (ppr expr)
getRegisterReg :: CmmReg -> Reg
-getRegisterReg (CmmLocal (LocalReg u pk))
+getRegisterReg (CmmLocal (LocalReg u pk _))
= mkVReg u pk
getRegisterReg (CmmGlobal mid)
getRegister (CmmLit (CmmFloat f F32)) = do
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData
| otherwise = do
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData
-- in
return (Any rep code)
- {- Case2: shift length is complex (non-immediate) -}
+ {- Case2: shift length is complex (non-immediate)
+ * y must go in %ecx.
+ * we cannot do y first *and* put its result in %ecx, because
+ %ecx might be clobbered by x.
+ * if we do y second, then x cannot be
+ in a clobbered reg. Also, we cannot clobber x's reg
+ with the instruction itself.
+ * so we can either:
+ - do y first, put its result in a fresh tmp, then copy it to %ecx later
+ - do y second and put its result into %ecx. x gets placed in a fresh
+ tmp. This is likely to be better, becuase the reg alloc can
+ eliminate this reg->reg move here (it won't eliminate the other one,
+ because the move is into the fixed %ecx).
+ -}
shift_code rep instr x y{-amount-} = do
- (x_reg, x_code) <- getNonClobberedReg x
+ x_code <- getAnyReg x
+ tmp <- getNewRegNat rep
y_code <- getAnyReg y
let
- code = x_code `appOL`
+ code = x_code tmp `appOL`
y_code ecx `snocOL`
- instr (OpReg ecx) (OpReg x_reg)
+ instr (OpReg ecx) (OpReg tmp)
-- in
- return (Fixed rep x_reg code)
+ return (Fixed rep tmp code)
--------------------
add_code :: MachRep -> CmmExpr -> CmmExpr -> NatM Register
getRegister (CmmLit (CmmFloat f frep)) = do
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let code dst =
LDATA ReadOnlyData [CmmDataLabel lbl,
--
return (CondCode False cond code)
+-- anything vs zero, using a mask
+-- TODO: Add some sanity checking!!!!
+condIntCode cond (CmmMachOp (MO_And rep) [x,o2]) (CmmLit (CmmInt 0 pk))
+ | (CmmLit (CmmInt mask pk2)) <- o2
+ = do
+ (x_reg, x_code) <- getSomeReg x
+ let
+ code = x_code `snocOL`
+ TEST pk (OpImm (ImmInteger mask)) (OpReg x_reg)
+ --
+ return (CondCode False cond code)
+
-- anything vs zero
condIntCode cond x (CmmLit (CmmInt 0 pk)) = do
(x_reg, x_code) <- getSomeReg x
genCCall
:: CmmCallTarget -- function to call
- -> [(CmmReg,MachHint)] -- where to put the result
- -> [(CmmExpr,MachHint)] -- arguments (of mixed type)
- -> Maybe [GlobalReg] -- volatile regs to save
+ -> CmmHintFormals -- where to put the result
+ -> CmmActuals -- arguments (of mixed type)
-> NatM InstrBlock
-- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
#if i386_TARGET_ARCH
-genCCall (CmmPrim MO_WriteBarrier) _ _ _ = return nilOL
+genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL
-- write barrier compiles to no code on x86/x86-64;
-- 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 vols = do
+genCCall (CmmPrim op) [(r,_)] args = do
case op of
MO_F32_Sqrt -> actuallyInlineFloatOp F32 (GSQRT F32) args
MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args
MO_F32_Tan -> actuallyInlineFloatOp F32 (GTAN F32) args
MO_F64_Tan -> actuallyInlineFloatOp F64 (GTAN F64) args
- other_op -> outOfLineFloatOp op r args vols
+ other_op -> outOfLineFloatOp op r args
where
actuallyInlineFloatOp rep instr [(x,_)]
= do res <- trivialUFCode rep instr x
any <- anyReg res
- return (any (getRegisterReg r))
+ return (any (getRegisterReg (CmmLocal r)))
-genCCall target dest_regs args vols = do
+genCCall target dest_regs args = do
let
sizes = map (arg_size . cmmExprRep . fst) (reverse args)
#if !darwin_TARGET_OS
(callinsns,cconv) <-
case target of
-- CmmPrim -> ...
- CmmForeignCall (CmmLit (CmmLabel lbl)) conv
+ CmmCallee (CmmLit (CmmLabel lbl)) conv
-> -- ToDo: stdcall arg sizes
return (unitOL (CALL (Left fn_imm) []), conv)
where fn_imm = ImmCLbl lbl
- CmmForeignCall expr conv
+ CmmCallee 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)
rep -> unitOL (MOV rep (OpReg eax) (OpReg r_dest))
where
r_dest_hi = getHiVRegFromLo r_dest
- rep = cmmRegRep dest
- r_dest = getRegisterReg dest
+ rep = localRegRep dest
+ r_dest = getRegisterReg (CmmLocal dest)
assign_code many = panic "genCCall.assign_code many"
return (push_code `appOL`
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
-outOfLineFloatOp :: CallishMachOp -> CmmReg -> [(CmmExpr,MachHint)]
- -> Maybe [GlobalReg] -> NatM InstrBlock
-outOfLineFloatOp mop res args vols
+outOfLineFloatOp :: CallishMachOp -> CmmFormal -> CmmActuals
+ -> NatM InstrBlock
+outOfLineFloatOp mop res args
= do
- targetExpr <- cmmMakeDynamicReference addImportNat CallReference lbl
- let target = CmmForeignCall targetExpr CCallConv
+ dflags <- getDynFlagsNat
+ targetExpr <- cmmMakeDynamicReference dflags addImportNat CallReference lbl
+ let target = CmmCallee targetExpr CCallConv
- if cmmRegRep res == F64
+ if localRegRep res == F64
then
- stmtToInstrs (CmmCall target [(res,FloatHint)] args vols)
+ stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn)
else do
uq <- getUniqueNat
let
- tmp = CmmLocal (LocalReg uq F64)
+ tmp = LocalReg uq F64 KindNonPtr
-- in
- code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args vols)
- code2 <- stmtToInstrs (CmmAssign res (CmmReg tmp))
+ code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
+ code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
return (code1 `appOL` code2)
where
lbl = mkForeignLabel fn Nothing False
#if x86_64_TARGET_ARCH
-genCCall (CmmPrim MO_WriteBarrier) _ _ _ = return nilOL
+genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL
-- 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 vols =
- outOfLineFloatOp op r args vols
+genCCall (CmmPrim op) [(r,_)] args =
+ outOfLineFloatOp op r args
-genCCall target dest_regs args vols = do
+genCCall target dest_regs args = do
-- load up the register arguments
(stack_args, aregs, fregs, load_args_code)
(callinsns,cconv) <-
case target of
-- CmmPrim -> ...
- CmmForeignCall (CmmLit (CmmLabel lbl)) conv
+ CmmCallee (CmmLit (CmmLabel lbl)) conv
-> -- ToDo: stdcall arg sizes
return (unitOL (CALL (Left fn_imm) arg_regs), conv)
where fn_imm = ImmCLbl lbl
- CmmForeignCall expr conv
+ CmmCallee expr conv
-> do (dyn_r, dyn_c) <- getSomeReg expr
return (dyn_c `snocOL` CALL (Right dyn_r) arg_regs, conv)
F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
rep -> unitOL (MOV rep (OpReg rax) (OpReg r_dest))
where
- rep = cmmRegRep dest
- r_dest = getRegisterReg dest
+ rep = localRegRep dest
+ r_dest = getRegisterReg (CmmLocal dest)
assign_code many = panic "genCCall.assign_code many"
return (load_args_code `appOL`
(arg_reg, arg_code) <- getSomeReg arg
delta <- getDeltaNat
setDeltaNat (delta-arg_size)
- let code' = code `appOL` toOL [
- MOV arg_rep (OpReg arg_reg) (OpAddr (spRel 0)),
+ let code' = code `appOL` arg_code `appOL` toOL [
SUB wordRep (OpImm (ImmInt arg_size)) (OpReg rsp) ,
- DELTA (delta-arg_size)]
+ DELTA (delta-arg_size),
+ MOV arg_rep (OpReg arg_reg) (OpAddr (spRel 0))]
push_args rest code'
| otherwise = do
stack only immediately prior to the call proper. Sigh.
-}
-genCCall target dest_regs argsAndHints vols = do
+genCCall target dest_regs argsAndHints = do
let
args = map fst argsAndHints
argcode_and_vregs <- mapM arg_to_int_vregs args
vregs = concat vregss
-- deal with static vs dynamic call targets
callinsns <- (case target of
- CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> do
+ CmmCallee (CmmLit (CmmLabel lbl)) conv -> do
return (unitOL (CALL (Left (litToImm (CmmLabel lbl))) n_argRegs_used False))
- CmmForeignCall expr conv -> do
+ CmmCallee expr conv -> do
(dyn_c, [dyn_r]) <- arg_to_int_vregs expr
return (dyn_c `snocOL` CALL (Right dyn_r) n_argRegs_used False)
CmmPrim mop -> do
)
outOfLineFloatOp mop =
do
- mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
+ dflags <- getDynFlagsNat
+ mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
mkForeignLabel functionName Nothing True
let mopLabelOrExpr = case mopExpr of
CmmLit (CmmLabel lbl) -> Left lbl
-}
-genCCall (CmmPrim MO_WriteBarrier) _ _ _
+genCCall (CmmPrim MO_WriteBarrier) _ _
= return $ unitOL LWSYNC
-genCCall target dest_regs argsAndHints vols
+genCCall target dest_regs argsAndHints
= ASSERT (not $ any (`elem` [I8,I16]) argReps)
-- we rely on argument promotion in the codeGen
do
(toOL []) []
(labelOrExpr, reduceToF32) <- case target of
- CmmForeignCall (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
- CmmForeignCall expr conv -> return (Right expr, False)
+ CmmCallee (CmmLit (CmmLabel lbl)) conv -> return (Left lbl, False)
+ CmmCallee expr conv -> return (Right expr, False)
CmmPrim mop -> outOfLineFloatOp mop
let codeBefore = move_sp_down finalStack `appOL` passArgumentsCode
| rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3,
MR r_dest r4]
| otherwise -> unitOL (MR r_dest r3)
- where rep = cmmRegRep dest
- r_dest = getRegisterReg dest
+ where rep = cmmRegRep (CmmLocal dest)
+ r_dest = getRegisterReg (CmmLocal dest)
outOfLineFloatOp mop =
do
- mopExpr <- cmmMakeDynamicReference addImportNat CallReference $
+ dflags <- getDynFlagsNat
+ mopExpr <- cmmMakeDynamicReference dflags addImportNat CallReference $
mkForeignLabel functionName Nothing True
let mopLabelOrExpr = case mopExpr of
CmmLit (CmmLabel lbl) -> Left lbl
= do
(reg,e_code) <- getSomeReg expr
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let
jumpTable = map jumpTableEntryRel ids
(reg,e_code) <- getSomeReg expr
tmp <- getNewRegNat I32
lbl <- getNewLabelNat
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
(tableReg,t_code) <- getSomeReg $ dynRef
let
jumpTable = map jumpTableEntryRel ids
-- -----------------------------------------------------------------------------
-- Coercing to/from integer/floating-point...
+-- When going to integer, we truncate (round towards 0).
+
-- @coerce(Int2FP|FP2Int)@ are more complicated integer/float
-- conversions. We have to store temporaries in memory to move
-- between the integer and the floating point register sets.
coerceFP2Int from to x = do
(x_op, x_code) <- getOperand x -- ToDo: could be a safe operand
let
- opc = case from of F32 -> CVTSS2SI; F64 -> CVTSD2SI
+ opc = case from of F32 -> CVTTSS2SIQ; F64 -> CVTTSD2SIQ
code dst = x_code `snocOL` opc x_op dst
-- in
return (Any to code) -- works even if the destination rep is <I32
lbl <- getNewLabelNat
itmp <- getNewRegNat I32
ftmp <- getNewRegNat F64
- dynRef <- cmmMakeDynamicReference addImportNat DataReference lbl
+ dflags <- getDynFlagsNat
+ dynRef <- cmmMakeDynamicReference dflags addImportNat DataReference lbl
Amode addr addr_code <- getAmode dynRef
let
code' dst = code `appOL` maybe_exts `appOL` toOL [
projects / ghc-hetmet.git / blobdiff