Commit e0d54c7d authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Remove most of the redundant Platform argument passing in nativeGen/X86/Ppr.hs

parent 2d969ff9
......@@ -52,25 +52,25 @@ pprNatCmmDecl platform (CmmData section dats) =
pprSectionHeader platform section $$ pprDatas platform dats
-- special case for split markers:
pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph [])) = pprLabel platform lbl
pprNatCmmDecl _ (CmmProc Nothing lbl (ListGraph [])) = pprLabel lbl
-- special case for code without info table:
pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph blocks)) =
pprSectionHeader platform Text $$
pprLabel platform lbl $$ -- blocks guaranteed not null, so label needed
vcat (map (pprBasicBlock platform) blocks) $$
pprLabel lbl $$ -- blocks guaranteed not null, so label needed
vcat (map pprBasicBlock blocks) $$
pprSizeDecl platform lbl
pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
pprSectionHeader platform Text $$
(
(if platformHasSubsectionsViaSymbols platform
then pprCLabel platform (mkDeadStripPreventer info_lbl) <> char ':'
then ppr (mkDeadStripPreventer info_lbl) <> char ':'
else empty) $$
vcat (map (pprData platform) info) $$
pprLabel platform info_lbl
pprLabel info_lbl
) $$
vcat (map (pprBasicBlock platform) blocks) $$
vcat (map pprBasicBlock blocks) $$
-- above: Even the first block gets a label, because with branch-chain
-- elimination, it might be the target of a goto.
(if platformHasSubsectionsViaSymbols platform
......@@ -82,9 +82,9 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
-- so that the linker will not think it is unreferenced and dead-strip
-- it. That's why the label is called a DeadStripPreventer (_dsp).
text "\t.long "
<+> pprCLabel platform info_lbl
<+> ppr info_lbl
<+> char '-'
<+> pprCLabel platform (mkDeadStripPreventer info_lbl)
<+> ppr (mkDeadStripPreventer info_lbl)
else empty) $$
pprSizeDecl platform info_lbl
......@@ -92,19 +92,19 @@ pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListG
pprSizeDecl :: Platform -> CLabel -> SDoc
pprSizeDecl platform lbl
| osElfTarget (platformOS platform) =
ptext (sLit "\t.size") <+> pprCLabel platform lbl
<> ptext (sLit ", .-") <> pprCLabel platform lbl
ptext (sLit "\t.size") <+> ppr lbl
<> ptext (sLit ", .-") <> ppr lbl
| otherwise = empty
pprBasicBlock :: Platform -> NatBasicBlock Instr -> SDoc
pprBasicBlock platform (BasicBlock blockid instrs) =
pprLabel platform (mkAsmTempLabel (getUnique blockid)) $$
vcat (map (pprInstr platform) instrs)
pprBasicBlock :: NatBasicBlock Instr -> SDoc
pprBasicBlock (BasicBlock blockid instrs) =
pprLabel (mkAsmTempLabel (getUnique blockid)) $$
vcat (map pprInstr instrs)
pprDatas :: Platform -> (Alignment, CmmStatics) -> SDoc
pprDatas platform (align, (Statics lbl dats))
= vcat (pprAlign platform align : pprLabel platform lbl : map (pprData platform) dats)
= vcat (pprAlign platform align : pprLabel lbl : map (pprData platform) dats)
-- TODO: could remove if align == 1
pprData :: Platform -> CmmStatic -> SDoc
......@@ -116,22 +116,22 @@ pprData platform (CmmUninitialised bytes)
pprData platform (CmmStaticLit lit) = pprDataItem platform lit
pprGloblDecl :: Platform -> CLabel -> SDoc
pprGloblDecl platform lbl
pprGloblDecl :: CLabel -> SDoc
pprGloblDecl lbl
| not (externallyVisibleCLabel lbl) = empty
| otherwise = ptext (sLit ".globl ") <> pprCLabel platform lbl
| otherwise = ptext (sLit ".globl ") <> ppr lbl
pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
pprTypeAndSizeDecl platform lbl
| osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
= ptext (sLit ".type ") <>
pprCLabel platform lbl <> ptext (sLit ", @object")
| otherwise = empty
pprTypeAndSizeDecl :: CLabel -> SDoc
pprTypeAndSizeDecl lbl
= sdocWithPlatform $ \platform ->
if osElfTarget (platformOS platform) && externallyVisibleCLabel lbl
then ptext (sLit ".type ") <> ppr lbl <> ptext (sLit ", @object")
else empty
pprLabel :: Platform -> CLabel -> SDoc
pprLabel platform lbl = pprGloblDecl platform lbl
$$ pprTypeAndSizeDecl platform lbl
$$ (pprCLabel platform lbl <> char ':')
pprLabel :: CLabel -> SDoc
pprLabel lbl = pprGloblDecl lbl
$$ pprTypeAndSizeDecl lbl
$$ (ppr lbl <> char ':')
pprASCII :: [Word8] -> SDoc
......@@ -160,13 +160,14 @@ pprAlign platform bytes
-- pprInstr: print an 'Instr'
instance Outputable Instr where
ppr instr = sdocWithPlatform $ \platform -> pprInstr platform instr
ppr instr = pprInstr instr
pprReg :: Platform -> Size -> Reg -> SDoc
pprReg platform s r
pprReg :: Size -> Reg -> SDoc
pprReg s r
= case r of
RegReal (RealRegSingle i) ->
sdocWithPlatform $ \platform ->
if target32Bit platform then ppr32_reg_no s i
else ppr64_reg_no s i
RegReal (RealRegPair _ _) -> panic "X86.Ppr: no reg pairs on this arch"
......@@ -313,25 +314,25 @@ pprCond c
ALWAYS -> sLit "mp"})
pprImm :: Platform -> Imm -> SDoc
pprImm _ (ImmInt i) = int i
pprImm _ (ImmInteger i) = integer i
pprImm platform (ImmCLbl l) = pprCLabel platform l
pprImm platform (ImmIndex l i) = pprCLabel platform l <> char '+' <> int i
pprImm _ (ImmLit s) = s
pprImm :: Imm -> SDoc
pprImm (ImmInt i) = int i
pprImm (ImmInteger i) = integer i
pprImm (ImmCLbl l) = ppr l
pprImm (ImmIndex l i) = ppr l <> char '+' <> int i
pprImm (ImmLit s) = s
pprImm _ (ImmFloat _) = ptext (sLit "naughty float immediate")
pprImm _ (ImmDouble _) = ptext (sLit "naughty double immediate")
pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
pprImm platform (ImmConstantSum a b) = pprImm platform a <> char '+' <> pprImm platform b
pprImm platform (ImmConstantDiff a b) = pprImm platform a <> char '-'
<> lparen <> pprImm platform b <> rparen
pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
<> lparen <> pprImm b <> rparen
pprAddr :: Platform -> AddrMode -> SDoc
pprAddr platform (ImmAddr imm off)
= let pp_imm = pprImm platform imm
pprAddr :: AddrMode -> SDoc
pprAddr (ImmAddr imm off)
= let pp_imm = pprImm imm
in
if (off == 0) then
pp_imm
......@@ -340,11 +341,12 @@ pprAddr platform (ImmAddr imm off)
else
pp_imm <> char '+' <> int off
pprAddr platform (AddrBaseIndex base index displacement)
= let
pprAddr (AddrBaseIndex base index displacement)
= sdocWithPlatform $ \platform ->
let
pp_disp = ppr_disp displacement
pp_off p = pp_disp <> char '(' <> p <> char ')'
pp_reg r = pprReg platform (archWordSize (target32Bit platform)) r
pp_reg r = pprReg (archWordSize (target32Bit platform)) r
in
case (base, index) of
(EABaseNone, EAIndexNone) -> pp_disp
......@@ -357,7 +359,7 @@ pprAddr platform (AddrBaseIndex base index displacement)
where
ppr_disp (ImmInt 0) = empty
ppr_disp imm = pprImm platform imm
ppr_disp imm = pprImm imm
pprSectionHeader :: Platform -> Section -> SDoc
......@@ -412,17 +414,17 @@ pprDataItem platform lit
imm = litToImm lit
-- These seem to be common:
ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm platform imm]
ppr_item II16 _ = [ptext (sLit "\t.word\t") <> pprImm platform imm]
ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm platform imm]
ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
ppr_item II16 _ = [ptext (sLit "\t.word\t") <> pprImm imm]
ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
ppr_item FF32 (CmmFloat r _)
= let bs = floatToBytes (fromRational r)
in map (\b -> ptext (sLit "\t.byte\t") <> pprImm platform (ImmInt b)) bs
in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
ppr_item FF64 (CmmFloat r _)
= let bs = doubleToBytes (fromRational r)
in map (\b -> ptext (sLit "\t.byte\t") <> pprImm platform (ImmInt b)) bs
in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
ppr_item II64 _
= case platformOS platform of
......@@ -437,10 +439,10 @@ pprDataItem platform lit
(fromIntegral (x `shiftR` 32) :: Word32))]
_ -> panic "X86.Ppr.ppr_item: no match for II64"
| otherwise ->
[ptext (sLit "\t.quad\t") <> pprImm platform imm]
[ptext (sLit "\t.quad\t") <> pprImm imm]
_
| target32Bit platform ->
[ptext (sLit "\t.quad\t") <> pprImm platform imm]
[ptext (sLit "\t.quad\t") <> pprImm imm]
| otherwise ->
-- x86_64: binutils can't handle the R_X86_64_PC64
-- relocation type, which means we can't do
......@@ -455,33 +457,33 @@ pprDataItem platform lit
case lit of
-- A relative relocation:
CmmLabelDiffOff _ _ _ ->
[ptext (sLit "\t.long\t") <> pprImm platform imm,
[ptext (sLit "\t.long\t") <> pprImm imm,
ptext (sLit "\t.long\t0")]
_ ->
[ptext (sLit "\t.quad\t") <> pprImm platform imm]
[ptext (sLit "\t.quad\t") <> pprImm imm]
ppr_item _ _
= panic "X86.Ppr.ppr_item: no match"
pprInstr :: Platform -> Instr -> SDoc
pprInstr :: Instr -> SDoc
pprInstr _ (COMMENT _) = empty -- nuke 'em
pprInstr (COMMENT _) = empty -- nuke 'em
{-
pprInstr _ (COMMENT s) = ptext (sLit "# ") <> ftext s
pprInstr (COMMENT s) = ptext (sLit "# ") <> ftext s
-}
pprInstr platform (DELTA d)
= pprInstr platform (COMMENT (mkFastString ("\tdelta = " ++ show d)))
pprInstr (DELTA d)
= pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
pprInstr _ (NEWBLOCK _)
pprInstr (NEWBLOCK _)
= panic "PprMach.pprInstr: NEWBLOCK"
pprInstr _ (LDATA _ _)
pprInstr (LDATA _ _)
= panic "PprMach.pprInstr: LDATA"
{-
pprInstr _ (SPILL reg slot)
pprInstr (SPILL reg slot)
= hcat [
ptext (sLit "\tSPILL"),
char ' ',
......@@ -489,7 +491,7 @@ pprInstr _ (SPILL reg slot)
comma,
ptext (sLit "SLOT") <> parens (int slot)]
pprInstr _ (RELOAD slot reg)
pprInstr (RELOAD slot reg)
= hcat [
ptext (sLit "\tRELOAD"),
char ' ',
......@@ -498,48 +500,50 @@ pprInstr _ (RELOAD slot reg)
pprUserReg reg]
-}
pprInstr platform (MOV size src dst)
= pprSizeOpOp platform (sLit "mov") size src dst
pprInstr (MOV size src dst)
= pprSizeOpOp (sLit "mov") size src dst
pprInstr platform (MOVZxL II32 src dst) = pprSizeOpOp platform (sLit "mov") II32 src dst
pprInstr (MOVZxL II32 src dst) = pprSizeOpOp (sLit "mov") II32 src dst
-- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
-- movl. But we represent it as a MOVZxL instruction, because
-- the reg alloc would tend to throw away a plain reg-to-reg
-- move, and we still want it to do that.
pprInstr platform (MOVZxL sizes src dst) = pprSizeOpOpCoerce platform (sLit "movz") sizes II32 src dst
pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes II32 src dst
-- zero-extension only needs to extend to 32 bits: on x86_64,
-- the remaining zero-extension to 64 bits is automatic, and the 32-bit
-- instruction is shorter.
pprInstr platform (MOVSxL sizes src dst) = pprSizeOpOpCoerce platform (sLit "movs") sizes (archWordSize (target32Bit platform)) src dst
pprInstr (MOVSxL sizes src dst)
= sdocWithPlatform $ \platform ->
pprSizeOpOpCoerce (sLit "movs") sizes (archWordSize (target32Bit platform)) src dst
-- here we do some patching, since the physical registers are only set late
-- in the code generation.
pprInstr platform (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
| reg1 == reg3
= pprSizeOpOp platform (sLit "add") size (OpReg reg2) dst
= pprSizeOpOp (sLit "add") size (OpReg reg2) dst
pprInstr platform (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
| reg2 == reg3
= pprSizeOpOp platform (sLit "add") size (OpReg reg1) dst
= pprSizeOpOp (sLit "add") size (OpReg reg1) dst
pprInstr platform (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
pprInstr (LEA size (OpAddr (AddrBaseIndex (EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
| reg1 == reg3
= pprInstr platform (ADD size (OpImm displ) dst)
= pprInstr (ADD size (OpImm displ) dst)
pprInstr platform (LEA size src dst) = pprSizeOpOp platform (sLit "lea") size src dst
pprInstr (LEA size src dst) = pprSizeOpOp (sLit "lea") size src dst
pprInstr platform (ADD size (OpImm (ImmInt (-1))) dst)
= pprSizeOp platform (sLit "dec") size dst
pprInstr platform (ADD size (OpImm (ImmInt 1)) dst)
= pprSizeOp platform (sLit "inc") size dst
pprInstr platform (ADD size src dst)
= pprSizeOpOp platform (sLit "add") size src dst
pprInstr platform (ADC size src dst)
= pprSizeOpOp platform (sLit "adc") size src dst
pprInstr platform (SUB size src dst) = pprSizeOpOp platform (sLit "sub") size src dst
pprInstr platform (IMUL size op1 op2) = pprSizeOpOp platform (sLit "imul") size op1 op2
pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
= pprSizeOp (sLit "dec") size dst
pprInstr (ADD size (OpImm (ImmInt 1)) dst)
= pprSizeOp (sLit "inc") size dst
pprInstr (ADD size src dst)
= pprSizeOpOp (sLit "add") size src dst
pprInstr (ADC size src dst)
= pprSizeOpOp (sLit "adc") size src dst
pprInstr (SUB size src dst) = pprSizeOpOp (sLit "sub") size src dst
pprInstr (IMUL size op1 op2) = pprSizeOpOp (sLit "imul") size op1 op2
{- A hack. The Intel documentation says that "The two and three
operand forms [of IMUL] may also be used with unsigned operands
......@@ -548,27 +552,27 @@ pprInstr platform (IMUL size op1 op2) = pprSizeOpOp platform (sLit "imul") size
however, cannot be used to determine if the upper half of the
result is non-zero." So there.
-}
pprInstr platform (AND size src dst) = pprSizeOpOp platform (sLit "and") size src dst
pprInstr platform (OR size src dst) = pprSizeOpOp platform (sLit "or") size src dst
pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst
pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst
pprInstr platform (XOR FF32 src dst) = pprOpOp platform (sLit "xorps") FF32 src dst
pprInstr platform (XOR FF64 src dst) = pprOpOp platform (sLit "xorpd") FF64 src dst
pprInstr platform (XOR size src dst) = pprSizeOpOp platform (sLit "xor") size src dst
pprInstr (XOR FF32 src dst) = pprOpOp (sLit "xorps") FF32 src dst
pprInstr (XOR FF64 src dst) = pprOpOp (sLit "xorpd") FF64 src dst
pprInstr (XOR size src dst) = pprSizeOpOp (sLit "xor") size src dst
pprInstr platform (POPCNT size src dst) = pprOpOp platform (sLit "popcnt") size src (OpReg dst)
pprInstr (POPCNT size src dst) = pprOpOp (sLit "popcnt") size src (OpReg dst)
pprInstr platform (NOT size op) = pprSizeOp platform (sLit "not") size op
pprInstr platform (NEGI size op) = pprSizeOp platform (sLit "neg") size op
pprInstr (NOT size op) = pprSizeOp (sLit "not") size op
pprInstr (NEGI size op) = pprSizeOp (sLit "neg") size op
pprInstr platform (SHL size src dst) = pprShift platform (sLit "shl") size src dst
pprInstr platform (SAR size src dst) = pprShift platform (sLit "sar") size src dst
pprInstr platform (SHR size src dst) = pprShift platform (sLit "shr") size src dst
pprInstr (SHL size src dst) = pprShift (sLit "shl") size src dst
pprInstr (SAR size src dst) = pprShift (sLit "sar") size src dst
pprInstr (SHR size src dst) = pprShift (sLit "shr") size src dst
pprInstr platform (BT size imm src) = pprSizeImmOp platform (sLit "bt") size imm src
pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src
pprInstr platform (CMP size src dst)
| is_float size = pprSizeOpOp platform (sLit "ucomi") size src dst -- SSE2
| otherwise = pprSizeOpOp platform (sLit "cmp") size src dst
pprInstr (CMP size src dst)
| is_float size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2
| otherwise = pprSizeOpOp (sLit "cmp") size src dst
where
-- This predicate is needed here and nowhere else
is_float FF32 = True
......@@ -576,64 +580,66 @@ pprInstr platform (CMP size src dst)
is_float FF80 = True
is_float _ = False
pprInstr platform (TEST size src dst) = pprSizeOpOp platform (sLit "test") size src dst
pprInstr platform (PUSH size op) = pprSizeOp platform (sLit "push") size op
pprInstr platform (POP size op) = pprSizeOp platform (sLit "pop") size op
pprInstr (TEST size src dst) = pprSizeOpOp (sLit "test") size src dst
pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op
pprInstr (POP size op) = pprSizeOp (sLit "pop") size op
-- both unused (SDM):
-- pprInstr PUSHA = ptext (sLit "\tpushal")
-- pprInstr POPA = ptext (sLit "\tpopal")
pprInstr _ NOP = ptext (sLit "\tnop")
pprInstr _ (CLTD II32) = ptext (sLit "\tcltd")
pprInstr _ (CLTD II64) = ptext (sLit "\tcqto")
pprInstr NOP = ptext (sLit "\tnop")
pprInstr (CLTD II32) = ptext (sLit "\tcltd")
pprInstr (CLTD II64) = ptext (sLit "\tcqto")
pprInstr platform (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand platform II8 op)
pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
pprInstr platform (JXX cond blockid)
= pprCondInstr (sLit "j") cond (pprCLabel platform lab)
pprInstr (JXX cond blockid)
= pprCondInstr (sLit "j") cond (ppr lab)
where lab = mkAsmTempLabel (getUnique blockid)
pprInstr platform (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm platform imm)
pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
pprInstr platform (JMP (OpImm imm) _) = (<>) (ptext (sLit "\tjmp ")) (pprImm platform imm)
pprInstr platform (JMP op _) = (<>) (ptext (sLit "\tjmp *")) (pprOperand platform (archWordSize (target32Bit platform)) op)
pprInstr platform (JMP_TBL op _ _ _) = pprInstr platform (JMP op [])
pprInstr platform (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm platform imm)
pprInstr platform (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg platform (archWordSize (target32Bit platform)) reg)
pprInstr (JMP (OpImm imm) _) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm)
pprInstr (JMP op _) = sdocWithPlatform $ \platform ->
(<>) (ptext (sLit "\tjmp *")) (pprOperand (archWordSize (target32Bit platform)) op)
pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op [])
pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
pprInstr (CALL (Right reg) _) = sdocWithPlatform $ \platform ->
(<>) (ptext (sLit "\tcall *")) (pprReg (archWordSize (target32Bit platform)) reg)
pprInstr platform (IDIV sz op) = pprSizeOp platform (sLit "idiv") sz op
pprInstr platform (DIV sz op) = pprSizeOp platform (sLit "div") sz op
pprInstr platform (IMUL2 sz op) = pprSizeOp platform (sLit "imul") sz op
pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op
pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op
pprInstr (IMUL2 sz op) = pprSizeOp (sLit "imul") sz op
-- x86_64 only
pprInstr platform (MUL size op1 op2) = pprSizeOpOp platform (sLit "mul") size op1 op2
pprInstr platform (MUL2 size op) = pprSizeOp platform (sLit "mul") size op
pprInstr (MUL size op1 op2) = pprSizeOpOp (sLit "mul") size op1 op2
pprInstr (MUL2 size op) = pprSizeOp (sLit "mul") size op
pprInstr platform (FDIV size op1 op2) = pprSizeOpOp platform (sLit "div") size op1 op2
pprInstr (FDIV size op1 op2) = pprSizeOpOp (sLit "div") size op1 op2
pprInstr platform (CVTSS2SD from to) = pprRegReg platform (sLit "cvtss2sd") from to
pprInstr platform (CVTSD2SS from to) = pprRegReg platform (sLit "cvtsd2ss") from to
pprInstr platform (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg platform (sLit "cvttss2si") FF32 sz from to
pprInstr platform (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg platform (sLit "cvttsd2si") FF64 sz from to
pprInstr platform (CVTSI2SS sz from to) = pprSizeOpReg platform (sLit "cvtsi2ss") sz from to
pprInstr platform (CVTSI2SD sz from to) = pprSizeOpReg platform (sLit "cvtsi2sd") sz from to
pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
pprInstr (CVTTSS2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttss2si") FF32 sz from to
pprInstr (CVTTSD2SIQ sz from to) = pprSizeSizeOpReg (sLit "cvttsd2si") FF64 sz from to
pprInstr (CVTSI2SS sz from to) = pprSizeOpReg (sLit "cvtsi2ss") sz from to
pprInstr (CVTSI2SD sz from to) = pprSizeOpReg (sLit "cvtsi2sd") sz from to
-- FETCHGOT for PIC on ELF platforms
pprInstr platform (FETCHGOT reg)
pprInstr (FETCHGOT reg)
= vcat [ ptext (sLit "\tcall 1f"),
hcat [ ptext (sLit "1:\tpopl\t"), pprReg platform II32 reg ],
hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ],
hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
pprReg platform II32 reg ]
pprReg II32 reg ]
]
-- FETCHPC for PIC on Darwin/x86
-- get the instruction pointer into a register
-- (Terminology note: the IP is called Program Counter on PPC,
-- and it's a good thing to use the same name on both platforms)
pprInstr platform (FETCHPC reg)
pprInstr (FETCHPC reg)
= vcat [ ptext (sLit "\tcall 1f"),
hcat [ ptext (sLit "1:\tpopl\t"), pprReg platform II32 reg ]
hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ]
]
......@@ -643,36 +649,36 @@ pprInstr platform (FETCHPC reg)
-- Simulating a flat register set on the x86 FP stack is tricky.
-- you have to free %st(7) before pushing anything on the FP reg stack
-- so as to preclude the possibility of a FP stack overflow exception.
pprInstr platform g@(GMOV src dst)
pprInstr g@(GMOV src dst)
| src == dst
= empty
| otherwise
= pprG platform g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
= pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
-- GLD sz addr dst ==> FLDsz addr ; FSTP (dst+1)
pprInstr platform g@(GLD sz addr dst)
= pprG platform g (hcat [gtab, text "fld", pprSize_x87 sz, gsp,
pprAddr platform addr, gsemi, gpop dst 1])
pprInstr g@(GLD sz addr dst)
= pprG g (hcat [gtab, text "fld", pprSize_x87 sz, gsp,
pprAddr addr, gsemi, gpop dst 1])
-- GST sz src addr ==> FLD dst ; FSTPsz addr
pprInstr platform g@(GST sz src addr)
pprInstr g@(GST sz src addr)
| src == fake0 && sz /= FF80 -- fstt instruction doesn't exist
= pprG platform g (hcat [gtab,
text "fst", pprSize_x87 sz, gsp, pprAddr platform addr])
= pprG g (hcat [gtab,
text "fst", pprSize_x87 sz, gsp, pprAddr addr])
| otherwise
= pprG platform g (hcat [gtab, gpush src 0, gsemi,
text "fstp", pprSize_x87 sz, gsp, pprAddr platform addr])
= pprG g (hcat [gtab, gpush src 0, gsemi,
text "fstp", pprSize_x87 sz, gsp, pprAddr addr])
pprInstr platform g@(GLDZ dst)
= pprG platform g (hcat [gtab, text "fldz ; ", gpop dst 1])
pprInstr platform g@(GLD1 dst)
= pprG platform g (hcat [gtab, text "fld1 ; ", gpop dst 1])
pprInstr g@(GLDZ dst)
= pprG g (hcat [gtab, text "fldz ; ", gpop dst 1])
pprInstr g@(GLD1 dst)
= pprG g (hcat [gtab, text "fld1 ; ", gpop dst 1])
pprInstr platform (GFTOI src dst)
= pprInstr platform (GDTOI src dst)
pprInstr (GFTOI src dst)
= pprInstr (GDTOI src dst)
pprInstr platform g@(GDTOI src dst)
= pprG platform g (vcat [
pprInstr g@(GDTOI src dst)
= pprG g (vcat [
hcat [gtab, text "subl $8, %esp ; fnstcw 4(%esp)"],
hcat [gtab, gpush src 0],
hcat [gtab, text "movzwl 4(%esp), ", reg,
......@@ -683,20 +689,20 @@ pprInstr platform g@(GDTOI src dst)
hcat [gtab, text "addl $8, %esp"]
])
where
reg = pprReg platform II32 dst
reg = pprReg II32 dst
pprInstr platform (GITOF src dst)
= pprInstr platform (GITOD src dst)
pprInstr (GITOF src dst)
= pprInstr (GITOD src dst)
pprInstr platform g@(GITOD src dst)
= pprG platform g (hcat [gtab, text "pushl ", pprReg platform II32 src,
text " ; fildl (%esp) ; ",
gpop dst 1, text " ; addl $4,%esp"])
pprInstr g@(GITOD src dst)
= pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
text " ; fildl (%esp) ; ",
gpop dst 1, text " ; addl $4,%esp"])
pprInstr platform g@(GDTOF src dst)
= pprG platform g (vcat [gtab <> gpush src 0,
gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
gtab <> gpop dst 1])
pprInstr g@(GDTOF src dst)
= pprG g (vcat [gtab <> gpush src 0,
gtab <> text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
gtab <> gpop dst 1])
{- Gruesome swamp follows. If you're unfortunate enough to have ventured
this far into the jungle AND you give a Rat's Ass (tm) what's going
......@@ -736,9 +742,9 @@ pprInstr platform g@(GDTOF src dst)
decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
else (%al == 0xFF, ZF=0)