ghc-8.2.1: nativeGen/SPARC/CodeGen/Gen32.hs
-- | Evaluation of 32 bit values.
module SPARC.CodeGen.Gen32 (
getSomeReg,
getRegister
)
where
import SPARC.CodeGen.CondCode
import SPARC.CodeGen.Amode
import SPARC.CodeGen.Gen64
import SPARC.CodeGen.Base
import SPARC.Stack
import SPARC.Instr
import SPARC.Cond
import SPARC.AddrMode
import SPARC.Imm
import SPARC.Regs
import SPARC.Base
import NCGMonad
import Format
import Reg
import Cmm
import Control.Monad (liftM)
import DynFlags
import OrdList
import Outputable
-- | The dual to getAnyReg: compute an expression into a register, but
-- we don't mind which one it is.
getSomeReg :: CmmExpr -> NatM (Reg, InstrBlock)
getSomeReg expr = do
r <- getRegister expr
case r of
Any rep code -> do
tmp <- getNewRegNat rep
return (tmp, code tmp)
Fixed _ reg code ->
return (reg, code)
-- | Make code to evaluate a 32 bit expression.
--
getRegister :: CmmExpr -> NatM Register
getRegister (CmmReg reg)
= do dflags <- getDynFlags
let platform = targetPlatform dflags
return (Fixed (cmmTypeFormat (cmmRegType dflags reg))
(getRegisterReg platform reg) nilOL)
getRegister tree@(CmmRegOff _ _)
= do dflags <- getDynFlags
getRegister (mangleIndexTree dflags tree)
getRegister (CmmMachOp (MO_UU_Conv W64 W32)
[CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
ChildCode64 code rlo <- iselExpr64 x
return $ Fixed II32 (getHiVRegFromLo rlo) code
getRegister (CmmMachOp (MO_SS_Conv W64 W32)
[CmmMachOp (MO_U_Shr W64) [x,CmmLit (CmmInt 32 _)]]) = do
ChildCode64 code rlo <- iselExpr64 x
return $ Fixed II32 (getHiVRegFromLo rlo) code
getRegister (CmmMachOp (MO_UU_Conv W64 W32) [x]) = do
ChildCode64 code rlo <- iselExpr64 x
return $ Fixed II32 rlo code
getRegister (CmmMachOp (MO_SS_Conv W64 W32) [x]) = do
ChildCode64 code rlo <- iselExpr64 x
return $ Fixed II32 rlo code
-- Load a literal float into a float register.
-- The actual literal is stored in a new data area, and we load it
-- at runtime.
getRegister (CmmLit (CmmFloat f W32)) = do
-- a label for the new data area
lbl <- getNewLabelNat
tmp <- getNewRegNat II32
let code dst = toOL [
-- the data area
LDATA (Section ReadOnlyData lbl) $ Statics lbl
[CmmStaticLit (CmmFloat f W32)],
-- load the literal
SETHI (HI (ImmCLbl lbl)) tmp,
LD II32 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
return (Any FF32 code)
getRegister (CmmLit (CmmFloat d W64)) = do
lbl <- getNewLabelNat
tmp <- getNewRegNat II32
let code dst = toOL [
LDATA (Section ReadOnlyData lbl) $ Statics lbl
[CmmStaticLit (CmmFloat d W64)],
SETHI (HI (ImmCLbl lbl)) tmp,
LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
return (Any FF64 code)
-- Unary machine ops
getRegister (CmmMachOp mop [x])
= case mop of
-- Floating point negation -------------------------
MO_F_Neg W32 -> trivialUFCode FF32 (FNEG FF32) x
MO_F_Neg W64 -> trivialUFCode FF64 (FNEG FF64) x
-- Integer negation --------------------------------
MO_S_Neg rep -> trivialUCode (intFormat rep) (SUB False False g0) x
MO_Not rep -> trivialUCode (intFormat rep) (XNOR False g0) x
-- Float word size conversion ----------------------
MO_FF_Conv W64 W32 -> coerceDbl2Flt x
MO_FF_Conv W32 W64 -> coerceFlt2Dbl x
-- Float <-> Signed Int conversion -----------------
MO_FS_Conv from to -> coerceFP2Int from to x
MO_SF_Conv from to -> coerceInt2FP from to x
-- Unsigned integer word size conversions ----------
-- If it's the same size, then nothing needs to be done.
MO_UU_Conv from to
| from == to -> conversionNop (intFormat to) x
-- To narrow an unsigned word, mask out the high bits to simulate what would
-- happen if we copied the value into a smaller register.
MO_UU_Conv W16 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
MO_UU_Conv W32 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
-- for narrowing 32 bit to 16 bit, don't use a literal mask value like the W16->W8
-- case because the only way we can load it is via SETHI, which needs 2 ops.
-- Do some shifts to chop out the high bits instead.
MO_UU_Conv W32 W16
-> do tmpReg <- getNewRegNat II32
(xReg, xCode) <- getSomeReg x
let code dst
= xCode
`appOL` toOL
[ SLL xReg (RIImm $ ImmInt 16) tmpReg
, SRL tmpReg (RIImm $ ImmInt 16) dst]
return $ Any II32 code
-- trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
-- To widen an unsigned word we don't have to do anything.
-- Just leave it in the same register and mark the result as the new size.
MO_UU_Conv W8 W16 -> conversionNop (intFormat W16) x
MO_UU_Conv W8 W32 -> conversionNop (intFormat W32) x
MO_UU_Conv W16 W32 -> conversionNop (intFormat W32) x
-- Signed integer word size conversions ------------
-- Mask out high bits when narrowing them
MO_SS_Conv W16 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
MO_SS_Conv W32 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
MO_SS_Conv W32 W16 -> trivialCode W16 (AND False) x (CmmLit (CmmInt 65535 W16))
-- Sign extend signed words when widening them.
MO_SS_Conv W8 W16 -> integerExtend W8 W16 x
MO_SS_Conv W8 W32 -> integerExtend W8 W32 x
MO_SS_Conv W16 W32 -> integerExtend W16 W32 x
_ -> panic ("Unknown unary mach op: " ++ show mop)
-- Binary machine ops
getRegister (CmmMachOp mop [x, y])
= case mop of
MO_Eq _ -> condIntReg EQQ x y
MO_Ne _ -> condIntReg NE x y
MO_S_Gt _ -> condIntReg GTT x y
MO_S_Ge _ -> condIntReg GE x y
MO_S_Lt _ -> condIntReg LTT x y
MO_S_Le _ -> condIntReg LE x y
MO_U_Gt W32 -> condIntReg GU x y
MO_U_Ge W32 -> condIntReg GEU x y
MO_U_Lt W32 -> condIntReg LU x y
MO_U_Le W32 -> condIntReg LEU x y
MO_U_Gt W16 -> condIntReg GU x y
MO_U_Ge W16 -> condIntReg GEU x y
MO_U_Lt W16 -> condIntReg LU x y
MO_U_Le W16 -> condIntReg LEU x y
MO_Add W32 -> trivialCode W32 (ADD False False) x y
MO_Sub W32 -> trivialCode W32 (SUB False False) x y
MO_S_MulMayOflo rep -> imulMayOflo rep x y
MO_S_Quot W32 -> idiv True False x y
MO_U_Quot W32 -> idiv False False x y
MO_S_Rem W32 -> irem True x y
MO_U_Rem W32 -> irem False x y
MO_F_Eq _ -> condFltReg EQQ x y
MO_F_Ne _ -> condFltReg NE x y
MO_F_Gt _ -> condFltReg GTT x y
MO_F_Ge _ -> condFltReg GE x y
MO_F_Lt _ -> condFltReg LTT x y
MO_F_Le _ -> condFltReg LE x y
MO_F_Add w -> trivialFCode w FADD x y
MO_F_Sub w -> trivialFCode w FSUB x y
MO_F_Mul w -> trivialFCode w FMUL x y
MO_F_Quot w -> trivialFCode w FDIV x y
MO_And rep -> trivialCode rep (AND False) x y
MO_Or rep -> trivialCode rep (OR False) x y
MO_Xor rep -> trivialCode rep (XOR False) x y
MO_Mul rep -> trivialCode rep (SMUL False) x y
MO_Shl rep -> trivialCode rep SLL x y
MO_U_Shr rep -> trivialCode rep SRL x y
MO_S_Shr rep -> trivialCode rep SRA x y
_ -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
getRegister (CmmLoad mem pk) = do
Amode src code <- getAmode mem
let
code__2 dst = code `snocOL` LD (cmmTypeFormat pk) src dst
return (Any (cmmTypeFormat pk) code__2)
getRegister (CmmLit (CmmInt i _))
| fits13Bits i
= let
src = ImmInt (fromInteger i)
code dst = unitOL (OR False g0 (RIImm src) dst)
in
return (Any II32 code)
getRegister (CmmLit lit)
= let imm = litToImm lit
code dst = toOL [
SETHI (HI imm) dst,
OR False dst (RIImm (LO imm)) dst]
in return (Any II32 code)
getRegister _
= panic "SPARC.CodeGen.Gen32.getRegister: no match"
-- | sign extend and widen
integerExtend
:: Width -- ^ width of source expression
-> Width -- ^ width of result
-> CmmExpr -- ^ source expression
-> NatM Register
integerExtend from to expr
= do -- load the expr into some register
(reg, e_code) <- getSomeReg expr
tmp <- getNewRegNat II32
let bitCount
= case (from, to) of
(W8, W32) -> 24
(W16, W32) -> 16
(W8, W16) -> 24
_ -> panic "SPARC.CodeGen.Gen32: no match"
let code dst
= e_code
-- local shift word left to load the sign bit
`snocOL` SLL reg (RIImm (ImmInt bitCount)) tmp
-- arithmetic shift right to sign extend
`snocOL` SRA tmp (RIImm (ImmInt bitCount)) dst
return (Any (intFormat to) code)
-- | For nop word format conversions we set the resulting value to have the
-- required size, but don't need to generate any actual code.
--
conversionNop
:: Format -> CmmExpr -> NatM Register
conversionNop new_rep expr
= do e_code <- getRegister expr
return (setFormatOfRegister e_code new_rep)
-- | Generate an integer division instruction.
idiv :: Bool -> Bool -> CmmExpr -> CmmExpr -> NatM Register
-- For unsigned division with a 32 bit numerator,
-- we can just clear the Y register.
idiv False cc x y
= do
(a_reg, a_code) <- getSomeReg x
(b_reg, b_code) <- getSomeReg y
let code dst
= a_code
`appOL` b_code
`appOL` toOL
[ WRY g0 g0
, UDIV cc a_reg (RIReg b_reg) dst]
return (Any II32 code)
-- For _signed_ division with a 32 bit numerator,
-- we have to sign extend the numerator into the Y register.
idiv True cc x y
= do
(a_reg, a_code) <- getSomeReg x
(b_reg, b_code) <- getSomeReg y
tmp <- getNewRegNat II32
let code dst
= a_code
`appOL` b_code
`appOL` toOL
[ SRA a_reg (RIImm (ImmInt 16)) tmp -- sign extend
, SRA tmp (RIImm (ImmInt 16)) tmp
, WRY tmp g0
, SDIV cc a_reg (RIReg b_reg) dst]
return (Any II32 code)
-- | Do an integer remainder.
--
-- NOTE: The SPARC v8 architecture manual says that integer division
-- instructions _may_ generate a remainder, depending on the implementation.
-- If so it is _recommended_ that the remainder is placed in the Y register.
--
-- The UltraSparc 2007 manual says Y is _undefined_ after division.
--
-- The SPARC T2 doesn't store the remainder, not sure about the others.
-- It's probably best not to worry about it, and just generate our own
-- remainders.
--
irem :: Bool -> CmmExpr -> CmmExpr -> NatM Register
-- For unsigned operands:
-- Division is between a 64 bit numerator and a 32 bit denominator,
-- so we still have to clear the Y register.
irem False x y
= do
(a_reg, a_code) <- getSomeReg x
(b_reg, b_code) <- getSomeReg y
tmp_reg <- getNewRegNat II32
let code dst
= a_code
`appOL` b_code
`appOL` toOL
[ WRY g0 g0
, UDIV False a_reg (RIReg b_reg) tmp_reg
, UMUL False tmp_reg (RIReg b_reg) tmp_reg
, SUB False False a_reg (RIReg tmp_reg) dst]
return (Any II32 code)
-- For signed operands:
-- Make sure to sign extend into the Y register, or the remainder
-- will have the wrong sign when the numerator is negative.
--
-- TODO: When sign extending, GCC only shifts the a_reg right by 17 bits,
-- not the full 32. Not sure why this is, something to do with overflow?
-- If anyone cares enough about the speed of signed remainder they
-- can work it out themselves (then tell me). -- BL 2009/01/20
irem True x y
= do
(a_reg, a_code) <- getSomeReg x
(b_reg, b_code) <- getSomeReg y
tmp1_reg <- getNewRegNat II32
tmp2_reg <- getNewRegNat II32
let code dst
= a_code
`appOL` b_code
`appOL` toOL
[ SRA a_reg (RIImm (ImmInt 16)) tmp1_reg -- sign extend
, SRA tmp1_reg (RIImm (ImmInt 16)) tmp1_reg -- sign extend
, WRY tmp1_reg g0
, SDIV False a_reg (RIReg b_reg) tmp2_reg
, SMUL False tmp2_reg (RIReg b_reg) tmp2_reg
, SUB False False a_reg (RIReg tmp2_reg) dst]
return (Any II32 code)
imulMayOflo :: Width -> CmmExpr -> CmmExpr -> NatM Register
imulMayOflo rep a b
= do
(a_reg, a_code) <- getSomeReg a
(b_reg, b_code) <- getSomeReg b
res_lo <- getNewRegNat II32
res_hi <- getNewRegNat II32
let shift_amt = case rep of
W32 -> 31
W64 -> 63
_ -> panic "shift_amt"
let code dst = a_code `appOL` b_code `appOL`
toOL [
SMUL False a_reg (RIReg b_reg) res_lo,
RDY res_hi,
SRA res_lo (RIImm (ImmInt shift_amt)) res_lo,
SUB False False res_lo (RIReg res_hi) dst
]
return (Any II32 code)
-- -----------------------------------------------------------------------------
-- 'trivial*Code': deal with trivial instructions
-- Trivial (dyadic: 'trivialCode', floating-point: 'trivialFCode',
-- unary: 'trivialUCode', unary fl-pt:'trivialUFCode') instructions.
-- Only look for constants on the right hand side, because that's
-- where the generic optimizer will have put them.
-- Similarly, for unary instructions, we don't have to worry about
-- matching an StInt as the argument, because genericOpt will already
-- have handled the constant-folding.
trivialCode
:: Width
-> (Reg -> RI -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialCode _ instr x (CmmLit (CmmInt y _))
| fits13Bits y
= do
(src1, code) <- getSomeReg x
let
src2 = ImmInt (fromInteger y)
code__2 dst = code `snocOL` instr src1 (RIImm src2) dst
return (Any II32 code__2)
trivialCode _ instr x y = do
(src1, code1) <- getSomeReg x
(src2, code2) <- getSomeReg y
let
code__2 dst = code1 `appOL` code2 `snocOL`
instr src1 (RIReg src2) dst
return (Any II32 code__2)
trivialFCode
:: Width
-> (Format -> Reg -> Reg -> Reg -> Instr)
-> CmmExpr
-> CmmExpr
-> NatM Register
trivialFCode pk instr x y = do
dflags <- getDynFlags
(src1, code1) <- getSomeReg x
(src2, code2) <- getSomeReg y
tmp <- getNewRegNat FF64
let
promote x = FxTOy FF32 FF64 x tmp
pk1 = cmmExprType dflags x
pk2 = cmmExprType dflags y
code__2 dst =
if pk1 `cmmEqType` pk2 then
code1 `appOL` code2 `snocOL`
instr (floatFormat pk) src1 src2 dst
else if typeWidth pk1 == W32 then
code1 `snocOL` promote src1 `appOL` code2 `snocOL`
instr FF64 tmp src2 dst
else
code1 `appOL` code2 `snocOL` promote src2 `snocOL`
instr FF64 src1 tmp dst
return (Any (cmmTypeFormat $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64)
code__2)
trivialUCode
:: Format
-> (RI -> Reg -> Instr)
-> CmmExpr
-> NatM Register
trivialUCode format instr x = do
(src, code) <- getSomeReg x
let
code__2 dst = code `snocOL` instr (RIReg src) dst
return (Any format code__2)
trivialUFCode
:: Format
-> (Reg -> Reg -> Instr)
-> CmmExpr
-> NatM Register
trivialUFCode pk instr x = do
(src, code) <- getSomeReg x
let
code__2 dst = code `snocOL` instr src dst
return (Any pk code__2)
-- Coercions -------------------------------------------------------------------
-- | Coerce a integer value to floating point
coerceInt2FP :: Width -> Width -> CmmExpr -> NatM Register
coerceInt2FP width1 width2 x = do
(src, code) <- getSomeReg x
let
code__2 dst = code `appOL` toOL [
ST (intFormat width1) src (spRel (-2)),
LD (intFormat width1) (spRel (-2)) dst,
FxTOy (intFormat width1) (floatFormat width2) dst dst]
return (Any (floatFormat $ width2) code__2)
-- | Coerce a floating point value to integer
--
-- NOTE: On sparc v9 there are no instructions to move a value from an
-- FP register directly to an int register, so we have to use a load/store.
--
coerceFP2Int :: Width -> Width -> CmmExpr -> NatM Register
coerceFP2Int width1 width2 x
= do let fformat1 = floatFormat width1
fformat2 = floatFormat width2
iformat2 = intFormat width2
(fsrc, code) <- getSomeReg x
fdst <- getNewRegNat fformat2
let code2 dst
= code
`appOL` toOL
-- convert float to int format, leaving it in a float reg.
[ FxTOy fformat1 iformat2 fsrc fdst
-- store the int into mem, then load it back to move
-- it into an actual int reg.
, ST fformat2 fdst (spRel (-2))
, LD iformat2 (spRel (-2)) dst]
return (Any iformat2 code2)
-- | Coerce a double precision floating point value to single precision.
coerceDbl2Flt :: CmmExpr -> NatM Register
coerceDbl2Flt x = do
(src, code) <- getSomeReg x
return (Any FF32 (\dst -> code `snocOL` FxTOy FF64 FF32 src dst))
-- | Coerce a single precision floating point value to double precision
coerceFlt2Dbl :: CmmExpr -> NatM Register
coerceFlt2Dbl x = do
(src, code) <- getSomeReg x
return (Any FF64 (\dst -> code `snocOL` FxTOy FF32 FF64 src dst))
-- Condition Codes -------------------------------------------------------------
--
-- Evaluate a comparison, and get the result into a register.
--
-- Do not fill the delay slots here. you will confuse the register allocator.
--
condIntReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
condIntReg EQQ x (CmmLit (CmmInt 0 _)) = do
(src, code) <- getSomeReg x
let
code__2 dst = code `appOL` toOL [
SUB False True g0 (RIReg src) g0,
SUB True False g0 (RIImm (ImmInt (-1))) dst]
return (Any II32 code__2)
condIntReg EQQ x y = do
(src1, code1) <- getSomeReg x
(src2, code2) <- getSomeReg y
let
code__2 dst = code1 `appOL` code2 `appOL` toOL [
XOR False src1 (RIReg src2) dst,
SUB False True g0 (RIReg dst) g0,
SUB True False g0 (RIImm (ImmInt (-1))) dst]
return (Any II32 code__2)
condIntReg NE x (CmmLit (CmmInt 0 _)) = do
(src, code) <- getSomeReg x
let
code__2 dst = code `appOL` toOL [
SUB False True g0 (RIReg src) g0,
ADD True False g0 (RIImm (ImmInt 0)) dst]
return (Any II32 code__2)
condIntReg NE x y = do
(src1, code1) <- getSomeReg x
(src2, code2) <- getSomeReg y
let
code__2 dst = code1 `appOL` code2 `appOL` toOL [
XOR False src1 (RIReg src2) dst,
SUB False True g0 (RIReg dst) g0,
ADD True False g0 (RIImm (ImmInt 0)) dst]
return (Any II32 code__2)
condIntReg cond x y = do
bid1 <- liftM (\a -> seq a a) getBlockIdNat
bid2 <- liftM (\a -> seq a a) getBlockIdNat
CondCode _ cond cond_code <- condIntCode cond x y
let
code__2 dst
= cond_code
`appOL` toOL
[ BI cond False bid1
, NOP
, OR False g0 (RIImm (ImmInt 0)) dst
, BI ALWAYS False bid2
, NOP
, NEWBLOCK bid1
, OR False g0 (RIImm (ImmInt 1)) dst
, BI ALWAYS False bid2
, NOP
, NEWBLOCK bid2]
return (Any II32 code__2)
condFltReg :: Cond -> CmmExpr -> CmmExpr -> NatM Register
condFltReg cond x y = do
bid1 <- liftM (\a -> seq a a) getBlockIdNat
bid2 <- liftM (\a -> seq a a) getBlockIdNat
CondCode _ cond cond_code <- condFltCode cond x y
let
code__2 dst
= cond_code
`appOL` toOL
[ NOP
, BF cond False bid1
, NOP
, OR False g0 (RIImm (ImmInt 0)) dst
, BI ALWAYS False bid2
, NOP
, NEWBLOCK bid1
, OR False g0 (RIImm (ImmInt 1)) dst
, BI ALWAYS False bid2
, NOP
, NEWBLOCK bid2 ]
return (Any II32 code__2)