import MachRegs
import NCGMonad
import PositionIndependentCode
-import RegAllocInfo ( mkBranchInstr )
+import RegAllocInfo ( mkBranchInstr, mkRegRegMoveInstr )
+import MachRegs
+import PprMach
-- Our intermediate code:
import BlockId
import Data.Word
import Data.Int
+
-- -----------------------------------------------------------------------------
-- Top-level of the instruction selector
mov_lo = ST II32 rlo (AddrRegImm src (ImmInt 4))
return (vcode `appOL` code `snocOL` mov_hi `snocOL` mov_lo)
-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 pk
+ r_dst_lo = mkVReg u_dst (cmmTypeSize pk)
r_dst_hi = getHiVRegFromLo r_dst_lo
r_src_hi = getHiVRegFromLo r_src_lo
mov_lo = mkMOV r_src_lo r_dst_lo
= panic "assignReg_I64Code(sparc): invalid lvalue"
--- Don't delete this -- it's very handy for debugging.
---iselExpr64 expr
--- | trace ("iselExpr64: " ++ showSDoc (ppr expr)) False
--- = panic "iselExpr64(???)"
+-- Load a 64 bit word
+iselExpr64 (CmmLoad addrTree ty)
+ | isWord64 ty
+ = do Amode amode addr_code <- getAmode addrTree
+ let result
+
+ | AddrRegReg r1 r2 <- amode
+ = do rlo <- getNewRegNat II32
+ tmp <- getNewRegNat II32
+ let rhi = getHiVRegFromLo rlo
+
+ return $ ChildCode64
+ ( addr_code
+ `appOL` toOL
+ [ ADD False False r1 (RIReg r2) tmp
+ , LD II32 (AddrRegImm tmp (ImmInt 0)) rhi
+ , LD II32 (AddrRegImm tmp (ImmInt 4)) rlo ])
+ rlo
+
+ | AddrRegImm r1 (ImmInt i) <- amode
+ = do rlo <- getNewRegNat II32
+ let rhi = getHiVRegFromLo rlo
+
+ return $ ChildCode64
+ ( addr_code
+ `appOL` toOL
+ [ LD II32 (AddrRegImm r1 (ImmInt $ 0 + i)) rhi
+ , LD II32 (AddrRegImm r1 (ImmInt $ 4 + i)) rlo ])
+ rlo
+
+ result
+
+
+-- Add a literal to a 64 bit integer
+iselExpr64 (CmmMachOp (MO_Add _) [e1, CmmLit (CmmInt i _)])
+ = do ChildCode64 code1 r1_lo <- iselExpr64 e1
+ let r1_hi = getHiVRegFromLo r1_lo
+
+ r_dst_lo <- getNewRegNat II32
+ let r_dst_hi = getHiVRegFromLo r_dst_lo
+
+ return $ ChildCode64
+ ( toOL
+ [ ADD False False r1_lo (RIImm (ImmInteger i)) r_dst_lo
+ , ADD True False r1_hi (RIReg g0) r_dst_hi ])
+ r_dst_lo
-iselExpr64 (CmmLoad addrTree ty) | isWord64 ty = do
- Amode (AddrRegReg r1 r2) addr_code <- getAmode addrTree
- rlo <- getNewRegNat II32
- let rhi = getHiVRegFromLo rlo
- mov_hi = LD II32 (AddrRegImm r1 (ImmInt 0)) rhi
- mov_lo = LD II32 (AddrRegImm r1 (ImmInt 4)) rlo
- return (
- ChildCode64 (addr_code `snocOL` mov_hi `snocOL` mov_lo)
- rlo
- )
-iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) isWord64 ty = do
- r_dst_lo <- getNewRegNat b32
+iselExpr64 (CmmReg (CmmLocal (LocalReg uq ty))) | isWord64 ty = do
+ r_dst_lo <- getNewRegNat II32
let r_dst_hi = getHiVRegFromLo r_dst_lo
- r_src_lo = mkVReg uq b32
+ r_src_lo = mkVReg uq II32
r_src_hi = getHiVRegFromLo r_src_lo
mov_lo = mkMOV r_src_lo r_dst_lo
mov_hi = mkMOV r_src_hi r_dst_hi
#if sparc_TARGET_ARCH
+-- getRegister :: CmmExpr -> NatM Register
+
+-- 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 ReadOnlyData
[CmmDataLabel lbl,
CmmStaticLit (CmmFloat f W32)],
- SETHI (HI (ImmCLbl lbl)) dst,
- LD FF32 (AddrRegImm dst (LO (ImmCLbl lbl))) dst]
+
+ -- 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 ReadOnlyData
[CmmDataLabel lbl,
CmmStaticLit (CmmFloat d W64)],
- SETHI (HI (ImmCLbl lbl)) dst,
- LD FF64 (AddrRegImm dst (LO (ImmCLbl lbl))) dst]
+ SETHI (HI (ImmCLbl lbl)) tmp,
+ LD II64 (AddrRegImm tmp (LO (ImmCLbl lbl))) dst]
return (Any FF64 code)
getRegister (CmmMachOp mop [x]) -- unary MachOps
-- Conversions which are a nop on sparc
MO_UU_Conv from to
- | from == to -> conversionNop to x
- MO_UU_Conv W32 W8 -> trivialCode I8 (AND False) x (CmmLit (CmmInt 255 I8))
- MO_UU_Conv W32 to -> conversionNop to x
- MO_SS_Conv W32 to -> conversionNop to x
+ | from == to -> conversionNop (intSize to) x
+ MO_UU_Conv W32 W8 -> trivialCode W8 (AND False) x (CmmLit (CmmInt 255 W8))
+ MO_UU_Conv W32 to -> conversionNop (intSize to) x
+ MO_SS_Conv W32 to -> conversionNop (intSize to) x
- -- widenings
- MO_UU_Conv W8 W32 -> integerExtend False W8 W32 x
- MO_UU_Conv W16 W32 -> integerExtend False W16 W32 x
- MO_UU_Conv W8 W16 -> integerExtend False W8 W16 x
- MO_SS_Conv W16 W32 -> integerExtend True W16 W32 x
+ MO_UU_Conv W8 to@W32 -> conversionNop (intSize to) x
+ MO_UU_Conv W16 to@W32 -> conversionNop (intSize to) x
+ MO_UU_Conv W8 to@W16 -> conversionNop (intSize to) x
- other_op -> panic "Unknown unary mach op"
+ -- sign extension
+ MO_SS_Conv W8 W32 -> integerExtend W8 W32 x
+ MO_SS_Conv W16 W32 -> integerExtend W16 W32 x
+ MO_SS_Conv W8 W16 -> integerExtend W8 W16 x
+
+ other_op -> panic ("Unknown unary mach op: " ++ show mop)
where
- -- XXX SLL/SRL?
- integerExtend signed from to expr = do
- (reg, e_code) <- getSomeReg expr
- let
- code dst =
- e_code `snocOL`
- ((if signed then SRA else SRL)
- reg (RIImm (ImmInt 0)) dst)
- return (Any (intSize to) code)
+
+ -- | 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
+ 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 (intSize to) code)
+
+
conversionNop new_rep expr
= do e_code <- getRegister expr
return (swizzleRegisterRep e_code new_rep)
MO_Sub W32 -> trivialCode W32 (SUB False False) x y
MO_S_MulMayOflo rep -> imulMayOflo rep x y
-{-
- -- ToDo: teach about V8+ SPARC div instructions
- MO_S_Quot W32 -> idiv FSLIT(".div") x y
- MO_S_Rem W32 -> idiv FSLIT(".rem") x y
- MO_U_Quot W32 -> idiv FSLIT(".udiv") x y
- MO_U_Rem W32 -> idiv FSLIT(".urem") 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 w -> condFltReg EQQ x y
MO_F_Ne w -> condFltReg NE x y
-}
other -> pprPanic "getRegister(sparc) - binary CmmMachOp (1)" (pprMachOp mop)
where
- --idiv fn x y = getRegister (StCall (Left fn) CCallConv II32 [x, y])
+ -- idiv fn x y = getRegister (StCall (Left fn) CCallConv II32 [x, y])
+
+
+ -- | 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 b32
- res_hi <- getNewRegNat b32
+ res_lo <- getNewRegNat II32
+ res_hi <- getNewRegNat II32
let
shift_amt = case rep of
W32 -> 31
getRegister (CmmLoad mem pk) = do
Amode src code <- getAmode mem
let
- code__2 dst = code `snocOL` LD pk src dst
- return (Any pk code__2)
+ code__2 dst = code `snocOL` LD (cmmTypeSize pk) src dst
+ return (Any (cmmTypeSize pk) code__2)
getRegister (CmmLit (CmmInt i _))
| fits13Bits i
code = codeX `appOL` codeY
return (Amode (AddrRegReg regX regY) code)
--- XXX Is this same as "leaf" in Stix?
getAmode (CmmLit lit)
= do
- tmp <- getNewRegNat b32
- let
- code = unitOL (SETHI (HI imm__2) tmp)
- return (Amode (AddrRegImm tmp (LO imm__2)) code)
- where
- imm__2 = litToImm lit
+ let imm__2 = litToImm lit
+ tmp1 <- getNewRegNat II32
+ tmp2 <- getNewRegNat II32
+
+ let code = toOL [ SETHI (HI imm__2) tmp1
+ , OR False tmp1 (RIImm (LO imm__2)) tmp2]
+
+ return (Amode (AddrRegReg tmp2 g0) code)
getAmode other
= do
pk2 = cmmExprType y
code__2 =
- if pk1 == pk2 then
+ if pk1 `cmmEqType` pk2 then
code1 `appOL` code2 `snocOL`
- FCMP True pk1 src1 src2
+ FCMP True (cmmTypeSize pk1) src1 src2
else if typeWidth pk1 == W32 then
code1 `snocOL` promote src1 `appOL` code2 `snocOL`
FCMP True FF64 tmp src2
r <- getRegister src
return $ case r of
Any _ code -> code dst
- Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg dst) freg
+ Fixed _ freg fcode -> fcode `snocOL` OR False g0 (RIReg freg) dst
where
dst = getRegisterReg reg
let
pk__2 = cmmExprType src
code__2 = code1 `appOL` code2 `appOL`
- if pk == pk__2
+ if sizeToWidth pk == typeWidth pk__2
then unitOL (ST pk src__2 dst__2)
- else toOL [FxTOy pk__2 pk src__2 tmp1, ST pk tmp1 dst__2]
+ else toOL [ FxTOy (cmmTypeSize pk__2) pk src__2 tmp1
+ , ST pk tmp1 dst__2]
return code__2
-- Floating point assignment to a register/temporary
--- ToDo: Verify correctness
-assignReg_FltCode pk reg src = do
- r <- getRegister src
- v1 <- getNewRegNat pk
- return $ case r of
- Any _ code -> code dst
- Fixed _ freg fcode -> fcode `snocOL` FMOV pk freg v1
- where
- dst = getRegisterReg reg
+assignReg_FltCode pk dstCmmReg srcCmmExpr = do
+ srcRegister <- getRegister srcCmmExpr
+ let dstReg = getRegisterReg dstCmmReg
+
+ return $ case srcRegister of
+ Any _ code -> code dstReg
+ Fixed _ srcFixedReg srcCode -> srcCode `snocOL` FMOV pk srcFixedReg dstReg
#endif /* sparc_TARGET_ARCH */
#if sparc_TARGET_ARCH
-genCondJump (BlockId id) bool = do
+genCondJump bid bool = do
CondCode is_float cond code <- getCondCode bool
return (
code `appOL`
toOL (
if is_float
- then [NOP, BF cond False (ImmCLbl (mkAsmTempLabel id)), NOP]
- else [BI cond False (ImmCLbl (mkAsmTempLabel id)), NOP]
+ then [NOP, BF cond False bid, NOP]
+ else [BI cond False bid, NOP]
)
)
in if nn <= 0
then (nilOL, nilOL)
else (unitOL (moveSp (-1*nn)), unitOL (moveSp (1*nn)))
+
transfer_code
= toOL (move_final vregs allArgRegs eXTRA_STK_ARGS_HERE)
+
+ -- assign the results, if necessary
+ assign_code [] = nilOL
+
+ assign_code [CmmHinted dest _hint]
+ = let rep = localRegType dest
+ width = typeWidth rep
+ r_dest = getRegisterReg (CmmLocal dest)
+
+ result
+ | isFloatType rep
+ , W32 <- width
+ = unitOL $ FMOV FF32 (RealReg $ fReg 0) r_dest
+
+ | isFloatType rep
+ , W64 <- width
+ = unitOL $ FMOV FF64 (RealReg $ fReg 0) r_dest
+
+ | not $ isFloatType rep
+ , W32 <- width
+ = unitOL $ mkRegRegMoveInstr (RealReg $ oReg 0) r_dest
+
+ in result
+
return (argcode `appOL`
move_sp_down `appOL`
transfer_code `appOL`
callinsns `appOL`
unitOL NOP `appOL`
- move_sp_up)
+ move_sp_up `appOL`
+ assign_code dest_regs)
where
-- move args from the integer vregs into which they have been
-- marshalled, into %o0 .. %o5, and the rest onto the stack.
| otherwise
= do
(src, code) <- getSomeReg arg
- tmp <- getNewRegNat (cmmExprType arg)
+ tmp <- getNewRegNat (cmmTypeSize $ cmmExprType arg)
let
- pk = cmmExprType arg
- case pk of
+ pk = cmmExprType arg
+ Just f0_high = fPair f0
+ case cmmTypeSize pk of
FF64 -> do
v1 <- getNewRegNat II32
v2 <- getNewRegNat II32
FMOV FF64 src f0 `snocOL`
ST FF32 f0 (spRel 16) `snocOL`
LD II32 (spRel 16) v1 `snocOL`
- ST FF32 (fPair f0) (spRel 16) `snocOL`
+ ST FF32 f0_high (spRel 16) `snocOL`
LD II32 (spRel 16) v2
,
[v1,v2]
BCTR [ id | Just id <- ids ]
]
return code
+#elif sparc_TARGET_ARCH
+genSwitch expr ids
+ | opt_PIC
+ = error "MachCodeGen: sparc genSwitch PIC not finished\n"
+
+ | otherwise
+ = error "MachCodeGen: sparc genSwitch non-PIC not finished\n"
#else
#error "ToDo: genSwitch"
#endif
return (Any II32 code__2)
condIntReg cond x y = do
- BlockId lbl1 <- getBlockIdNat
- BlockId lbl2 <- getBlockIdNat
+ bid1@(BlockId lbl1) <- getBlockIdNat
+ bid2@(BlockId lbl2) <- getBlockIdNat
CondCode _ cond cond_code <- condIntCode cond x y
let
code__2 dst = cond_code `appOL` toOL [
- BI cond False (ImmCLbl (mkAsmTempLabel lbl1)), NOP,
+ BI cond False bid1, NOP,
OR False g0 (RIImm (ImmInt 0)) dst,
- BI ALWAYS False (ImmCLbl (mkAsmTempLabel lbl2)), NOP,
- NEWBLOCK (BlockId lbl1),
+ BI ALWAYS False bid2, NOP,
+ NEWBLOCK bid1,
OR False g0 (RIImm (ImmInt 1)) dst,
- NEWBLOCK (BlockId lbl2)]
+ NEWBLOCK bid2]
return (Any II32 code__2)
condFltReg cond x y = do
- BlockId lbl1 <- getBlockIdNat
- BlockId lbl2 <- getBlockIdNat
+ bid1@(BlockId lbl1) <- getBlockIdNat
+ bid2@(BlockId lbl2) <- getBlockIdNat
CondCode _ cond cond_code <- condFltCode cond x y
let
code__2 dst = cond_code `appOL` toOL [
NOP,
- BF cond False (ImmCLbl (mkAsmTempLabel lbl1)), NOP,
+ BF cond False bid1, NOP,
OR False g0 (RIImm (ImmInt 0)) dst,
- BI ALWAYS False (ImmCLbl (mkAsmTempLabel lbl2)), NOP,
- NEWBLOCK (BlockId lbl1),
+ BI ALWAYS False bid2, NOP,
+ NEWBLOCK bid1,
OR False g0 (RIImm (ImmInt 1)) dst,
- NEWBLOCK (BlockId lbl2)]
+ NEWBLOCK bid2]
return (Any II32 code__2)
#endif /* sparc_TARGET_ARCH */
trivialFCode pk instr x y = do
(src1, code1) <- getSomeReg x
(src2, code2) <- getSomeReg y
- tmp1 <- getNewRegNat (cmmExprType x)
- tmp2 <- getNewRegNat (cmmExprType y)
+ tmp1 <- getNewRegNat (cmmTypeSize $ cmmExprType x)
+ tmp2 <- getNewRegNat (cmmTypeSize $ cmmExprType y)
tmp <- getNewRegNat FF64
let
promote x = FxTOy FF32 FF64 x tmp
pk2 = cmmExprType y
code__2 dst =
- if pk1 == pk2 then
+ if pk1 `cmmEqType` pk2 then
code1 `appOL` code2 `snocOL`
instr (floatSize pk) src1 src2 dst
else if typeWidth pk1 == W32 then
else
code1 `appOL` code2 `snocOL` promote src2 `snocOL`
instr FF64 src1 tmp dst
- return (Any (if pk1 == pk2 then pk1 else cmmFloat W64) code__2)
+ return (Any (cmmTypeSize $ if pk1 `cmmEqType` pk2 then pk1 else cmmFloat W64)
+ code__2)
------------
trivialUCode size instr x = do
#if sparc_TARGET_ARCH
-coerceInt2FP pk1 pk2 x = do
+coerceInt2FP width1 width2 x = do
(src, code) <- getSomeReg x
let
code__2 dst = code `appOL` toOL [
- ST pk1 src (spRel (-2)),
- LD pk1 (spRel (-2)) dst,
- FxTOy pk1 pk2 dst dst]
- return (Any pk2 code__2)
+ ST (intSize width1) src (spRel (-2)),
+ LD (intSize width1) (spRel (-2)) dst,
+ FxTOy (intSize width1) (floatSize width2) dst dst]
+ return (Any (floatSize $ width2) code__2)
------------
-coerceFP2Int pk fprep x = do
+coerceFP2Int width1 width2 x = do
+ let pk = intSize width1
+ fprep = floatSize width2
+
(src, code) <- getSomeReg x
reg <- getNewRegNat fprep
tmp <- getNewRegNat pk
projects / ghc-hetmet.git / blobdiff