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
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)
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.
(src, code) <- getSomeReg arg
tmp <- getNewRegNat (cmmTypeSize $ cmmExprType arg)
let
- pk = cmmExprType arg
+ pk = cmmExprType arg
+ Just f0_high = fPair f0
case cmmTypeSize pk of
FF64 -> do
v1 <- 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]
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 */
code__2 dst = code `appOL` toOL [
ST (intSize width1) src (spRel (-2)),
LD (intSize width1) (spRel (-2)) dst,
- FxTOy (intSize width1) (floatSize width1) dst dst]
+ FxTOy (intSize width1) (floatSize width2) dst dst]
return (Any (floatSize $ width2) code__2)
------------