summaryrefslogtreecommitdiff
path: root/compiler/nativeGen
diff options
context:
space:
mode:
authorIan Lynagh <igloo@earth.li>2012-07-18 19:55:36 +0100
committerIan Lynagh <igloo@earth.li>2012-07-18 19:55:36 +0100
commite0d54c7d432f3309336e3ed912ea14f06f8c9872 (patch)
tree445b494f8b43309fb73523ff2fc5b04a05b991eb /compiler/nativeGen
parent2d969ff971eab7d847c5870c8825409cbcf959b4 (diff)
downloadhaskell-e0d54c7d432f3309336e3ed912ea14f06f8c9872.tar.gz
Remove most of the redundant Platform argument passing in nativeGen/X86/Ppr.hs
Diffstat (limited to 'compiler/nativeGen')
-rw-r--r--compiler/nativeGen/X86/Ppr.hs661
1 files changed, 334 insertions, 327 deletions
diff --git a/compiler/nativeGen/X86/Ppr.hs b/compiler/nativeGen/X86/Ppr.hs
index 6e8320471d..1821baf54e 100644
--- a/compiler/nativeGen/X86/Ppr.hs
+++ b/compiler/nativeGen/X86/Ppr.hs
@@ -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)
-}
-pprInstr platform g@(GCMP cond src1 src2)
+pprInstr g@(GCMP cond src1 src2)
| case cond of { NE -> True; _ -> False }
- = pprG platform g (vcat [
+ = pprG g (vcat [
hcat [gtab, text "pushl %eax ; ",gpush src1 0],
hcat [gtab, text "fcomp ", greg src2 1,
text "; fstsw %ax ; sahf ; setpe %ah"],
@@ -746,7 +752,7 @@ pprInstr platform g@(GCMP cond src1 src2)
text "orb %ah,%al ; decb %al ; popl %eax"]
])
| otherwise
- = pprG platform g (vcat [
+ = pprG g (vcat [
hcat [gtab, text "pushl %eax ; ",gpush src1 0],
hcat [gtab, text "fcomp ", greg src2 1,
text "; fstsw %ax ; sahf ; setpo %ah"],
@@ -768,102 +774,101 @@ pprInstr platform g@(GCMP cond src1 src2)
-- there should be no others
-pprInstr platform g@(GABS _ src dst)
- = pprG platform g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
+pprInstr g@(GABS _ src dst)
+ = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
-pprInstr platform g@(GNEG _ src dst)
- = pprG platform g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
+pprInstr g@(GNEG _ src dst)
+ = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
-pprInstr platform g@(GSQRT sz src dst)
- = pprG platform g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
- hcat [gtab, gcoerceto sz, gpop dst 1])
+pprInstr g@(GSQRT sz src dst)
+ = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
+ hcat [gtab, gcoerceto sz, gpop dst 1])
-pprInstr platform g@(GSIN sz l1 l2 src dst)
- = pprG platform g (pprTrigOp platform "fsin" False l1 l2 src dst sz)
+pprInstr g@(GSIN sz l1 l2 src dst)
+ = pprG g (pprTrigOp "fsin" False l1 l2 src dst sz)
-pprInstr platform g@(GCOS sz l1 l2 src dst)
- = pprG platform g (pprTrigOp platform "fcos" False l1 l2 src dst sz)
+pprInstr g@(GCOS sz l1 l2 src dst)
+ = pprG g (pprTrigOp "fcos" False l1 l2 src dst sz)
-pprInstr platform g@(GTAN sz l1 l2 src dst)
- = pprG platform g (pprTrigOp platform "fptan" True l1 l2 src dst sz)
+pprInstr g@(GTAN sz l1 l2 src dst)
+ = pprG g (pprTrigOp "fptan" True l1 l2 src dst sz)
-- In the translations for GADD, GMUL, GSUB and GDIV,
-- the first two cases are mere optimisations. The otherwise clause
-- generates correct code under all circumstances.
-pprInstr platform g@(GADD _ src1 src2 dst)
+pprInstr g@(GADD _ src1 src2 dst)
| src1 == dst
- = pprG platform g (text "\t#GADD-xxxcase1" $$
- hcat [gtab, gpush src2 0,
- text " ; faddp %st(0),", greg src1 1])
+ = pprG g (text "\t#GADD-xxxcase1" $$
+ hcat [gtab, gpush src2 0,
+ text " ; faddp %st(0),", greg src1 1])
| src2 == dst
- = pprG platform g (text "\t#GADD-xxxcase2" $$
- hcat [gtab, gpush src1 0,
- text " ; faddp %st(0),", greg src2 1])
+ = pprG g (text "\t#GADD-xxxcase2" $$
+ hcat [gtab, gpush src1 0,
+ text " ; faddp %st(0),", greg src2 1])
| otherwise
- = pprG platform g (hcat [gtab, gpush src1 0,
- text " ; fadd ", greg src2 1, text ",%st(0)",
- gsemi, gpop dst 1])
+ = pprG g (hcat [gtab, gpush src1 0,
+ text " ; fadd ", greg src2 1, text ",%st(0)",
+ gsemi, gpop dst 1])
-pprInstr platform g@(GMUL _ src1 src2 dst)
+pprInstr g@(GMUL _ src1 src2 dst)
| src1 == dst
- = pprG platform g (text "\t#GMUL-xxxcase1" $$
- hcat [gtab, gpush src2 0,
- text " ; fmulp %st(0),", greg src1 1])
+ = pprG g (text "\t#GMUL-xxxcase1" $$
+ hcat [gtab, gpush src2 0,
+ text " ; fmulp %st(0),", greg src1 1])
| src2 == dst
- = pprG platform g (text "\t#GMUL-xxxcase2" $$
- hcat [gtab, gpush src1 0,
- text " ; fmulp %st(0),", greg src2 1])
+ = pprG g (text "\t#GMUL-xxxcase2" $$
+ hcat [gtab, gpush src1 0,
+ text " ; fmulp %st(0),", greg src2 1])
| otherwise
- = pprG platform g (hcat [gtab, gpush src1 0,
- text " ; fmul ", greg src2 1, text ",%st(0)",
- gsemi, gpop dst 1])
+ = pprG g (hcat [gtab, gpush src1 0,
+ text " ; fmul ", greg src2 1, text ",%st(0)",
+ gsemi, gpop dst 1])
-pprInstr platform g@(GSUB _ src1 src2 dst)
+pprInstr g@(GSUB _ src1 src2 dst)
| src1 == dst
- = pprG platform g (text "\t#GSUB-xxxcase1" $$
- hcat [gtab, gpush src2 0,
- text " ; fsubrp %st(0),", greg src1 1])
+ = pprG g (text "\t#GSUB-xxxcase1" $$
+ hcat [gtab, gpush src2 0,
+ text " ; fsubrp %st(0),", greg src1 1])
| src2 == dst
- = pprG platform g (text "\t#GSUB-xxxcase2" $$
- hcat [gtab, gpush src1 0,
- text " ; fsubp %st(0),", greg src2 1])
+ = pprG g (text "\t#GSUB-xxxcase2" $$
+ hcat [gtab, gpush src1 0,
+ text " ; fsubp %st(0),", greg src2 1])
| otherwise
- = pprG platform g (hcat [gtab, gpush src1 0,
- text " ; fsub ", greg src2 1, text ",%st(0)",
- gsemi, gpop dst 1])
+ = pprG g (hcat [gtab, gpush src1 0,
+ text " ; fsub ", greg src2 1, text ",%st(0)",
+ gsemi, gpop dst 1])
-pprInstr platform g@(GDIV _ src1 src2 dst)
+pprInstr g@(GDIV _ src1 src2 dst)
| src1 == dst
- = pprG platform g (text "\t#GDIV-xxxcase1" $$
- hcat [gtab, gpush src2 0,
- text " ; fdivrp %st(0),", greg src1 1])
+ = pprG g (text "\t#GDIV-xxxcase1" $$
+ hcat [gtab, gpush src2 0,
+ text " ; fdivrp %st(0),", greg src1 1])
| src2 == dst
- = pprG platform g (text "\t#GDIV-xxxcase2" $$
- hcat [gtab, gpush src1 0,
- text " ; fdivp %st(0),", greg src2 1])
+ = pprG g (text "\t#GDIV-xxxcase2" $$
+ hcat [gtab, gpush src1 0,
+ text " ; fdivp %st(0),", greg src2 1])
| otherwise
- = pprG platform g (hcat [gtab, gpush src1 0,
- text " ; fdiv ", greg src2 1, text ",%st(0)",
- gsemi, gpop dst 1])
+ = pprG g (hcat [gtab, gpush src1 0,
+ text " ; fdiv ", greg src2 1, text ",%st(0)",
+ gsemi, gpop dst 1])
-pprInstr _ GFREE
+pprInstr GFREE
= vcat [ ptext (sLit "\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
ptext (sLit "\tffree %st(4) ;ffree %st(5)")
]
-pprInstr _ _
+pprInstr _
= panic "X86.Ppr.pprInstr: no match"
-pprTrigOp :: Platform -> String -> Bool -> CLabel -> CLabel
+pprTrigOp :: String -> Bool -> CLabel -> CLabel
-> Reg -> Reg -> Size -> SDoc
-pprTrigOp platform
- op -- fsin, fcos or fptan
+pprTrigOp op -- fsin, fcos or fptan
isTan -- we need a couple of extra steps if we're doing tan
l1 l2 -- internal labels for us to use
src dst sz
@@ -877,7 +882,7 @@ pprTrigOp platform
hcat [gtab, text "fnstsw %ax"] $$
hcat [gtab, text "test $0x400,%eax"] $$
-- If we were in bounds then jump to the end
- hcat [gtab, text "je " <> pprCLabel platform l1] $$
+ hcat [gtab, text "je " <> ppr l1] $$
-- Otherwise we need to shrink the value. Start by
-- loading pi, doubleing it (by adding it to itself),
-- and then swapping pi with the value, so the value we
@@ -887,16 +892,16 @@ pprTrigOp platform
hcat [gtab, text "fxch %st(1)"] $$
-- Now we have a loop in which we make the value smaller,
-- see if it's small enough, and loop if not
- (pprCLabel platform l2 <> char ':') $$
+ (ppr l2 <> char ':') $$
hcat [gtab, text "fprem1"] $$
-- My Debian libc uses fstsw here for the tan code, but I can't
-- see any reason why it should need to be different for tan.
hcat [gtab, text "fnstsw %ax"] $$
hcat [gtab, text "test $0x400,%eax"] $$
- hcat [gtab, text "jne " <> pprCLabel platform l2] $$
+ hcat [gtab, text "jne " <> ppr l2] $$
hcat [gtab, text "fstp %st(1)"] $$
hcat [gtab, text op] $$
- (pprCLabel platform l1 <> char ':') $$
+ (ppr l1 <> char ':') $$
-- Pop the 1.0 tan gave us
(if isTan then hcat [gtab, text "fstp %st(0)"] else empty) $$
-- Restore %eax
@@ -937,49 +942,49 @@ gregno (RegReal (RealRegSingle i)) = i
gregno _ = --pprPanic "gregno" (ppr other)
999 -- bogus; only needed for debug printing
-pprG :: Platform -> Instr -> SDoc -> SDoc
-pprG platform fake actual
- = (char '#' <> pprGInstr platform fake) $$ actual
+pprG :: Instr -> SDoc -> SDoc
+pprG fake actual
+ = (char '#' <> pprGInstr fake) $$ actual
-pprGInstr :: Platform -> Instr -> SDoc
-pprGInstr platform (GMOV src dst) = pprSizeRegReg platform (sLit "gmov") FF64 src dst
-pprGInstr platform (GLD sz src dst) = pprSizeAddrReg platform (sLit "gld") sz src dst
-pprGInstr platform (GST sz src dst) = pprSizeRegAddr platform (sLit "gst") sz src dst
+pprGInstr :: Instr -> SDoc
+pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") FF64 src dst
+pprGInstr (GLD sz src dst) = pprSizeAddrReg (sLit "gld") sz src dst
+pprGInstr (GST sz src dst) = pprSizeRegAddr (sLit "gst") sz src dst
-pprGInstr platform (GLDZ dst) = pprSizeReg platform (sLit "gldz") FF64 dst
-pprGInstr platform (GLD1 dst) = pprSizeReg platform (sLit "gld1") FF64 dst
+pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst
+pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst
-pprGInstr platform (GFTOI src dst) = pprSizeSizeRegReg platform (sLit "gftoi") FF32 II32 src dst
-pprGInstr platform (GDTOI src dst) = pprSizeSizeRegReg platform (sLit "gdtoi") FF64 II32 src dst
+pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") FF32 II32 src dst
+pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") FF64 II32 src dst
-pprGInstr platform (GITOF src dst) = pprSizeSizeRegReg platform (sLit "gitof") II32 FF32 src dst
-pprGInstr platform (GITOD src dst) = pprSizeSizeRegReg platform (sLit "gitod") II32 FF64 src dst
-pprGInstr platform (GDTOF src dst) = pprSizeSizeRegReg platform (sLit "gdtof") FF64 FF32 src dst
+pprGInstr (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") II32 FF32 src dst
+pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") II32 FF64 src dst
+pprGInstr (GDTOF src dst) = pprSizeSizeRegReg (sLit "gdtof") FF64 FF32 src dst
-pprGInstr platform (GCMP co src dst) = pprCondRegReg platform (sLit "gcmp_") FF64 co src dst
-pprGInstr platform (GABS sz src dst) = pprSizeRegReg platform (sLit "gabs") sz src dst
-pprGInstr platform (GNEG sz src dst) = pprSizeRegReg platform (sLit "gneg") sz src dst
-pprGInstr platform (GSQRT sz src dst) = pprSizeRegReg platform (sLit "gsqrt") sz src dst
-pprGInstr platform (GSIN sz _ _ src dst) = pprSizeRegReg platform (sLit "gsin") sz src dst
-pprGInstr platform (GCOS sz _ _ src dst) = pprSizeRegReg platform (sLit "gcos") sz src dst
-pprGInstr platform (GTAN sz _ _ src dst) = pprSizeRegReg platform (sLit "gtan") sz src dst
+pprGInstr (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
+pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst
+pprGInstr (GNEG sz src dst) = pprSizeRegReg (sLit "gneg") sz src dst
+pprGInstr (GSQRT sz src dst) = pprSizeRegReg (sLit "gsqrt") sz src dst
+pprGInstr (GSIN sz _ _ src dst) = pprSizeRegReg (sLit "gsin") sz src dst
+pprGInstr (GCOS sz _ _ src dst) = pprSizeRegReg (sLit "gcos") sz src dst
+pprGInstr (GTAN sz _ _ src dst) = pprSizeRegReg (sLit "gtan") sz src dst
-pprGInstr platform (GADD sz src1 src2 dst) = pprSizeRegRegReg platform (sLit "gadd") sz src1 src2 dst
-pprGInstr platform (GSUB sz src1 src2 dst) = pprSizeRegRegReg platform (sLit "gsub") sz src1 src2 dst
-pprGInstr platform (GMUL sz src1 src2 dst) = pprSizeRegRegReg platform (sLit "gmul") sz src1 src2 dst
-pprGInstr platform (GDIV sz src1 src2 dst) = pprSizeRegRegReg platform (sLit "gdiv") sz src1 src2 dst
+pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg (sLit "gadd") sz src1 src2 dst
+pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg (sLit "gsub") sz src1 src2 dst
+pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg (sLit "gmul") sz src1 src2 dst
+pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg (sLit "gdiv") sz src1 src2 dst
-pprGInstr _ _ = panic "X86.Ppr.pprGInstr: no match"
+pprGInstr _ = panic "X86.Ppr.pprGInstr: no match"
-pprDollImm :: Platform -> Imm -> SDoc
-pprDollImm platform i = ptext (sLit "$") <> pprImm platform i
+pprDollImm :: Imm -> SDoc
+pprDollImm i = ptext (sLit "$") <> pprImm i
-pprOperand :: Platform -> Size -> Operand -> SDoc
-pprOperand platform s (OpReg r) = pprReg platform s r
-pprOperand platform _ (OpImm i) = pprDollImm platform i
-pprOperand platform _ (OpAddr ea) = pprAddr platform ea
+pprOperand :: Size -> Operand -> SDoc
+pprOperand s (OpReg r) = pprReg s r
+pprOperand _ (OpImm i) = pprDollImm i
+pprOperand _ (OpAddr ea) = pprAddr ea
pprMnemonic_ :: LitString -> SDoc
@@ -992,164 +997,166 @@ pprMnemonic name size =
char '\t' <> ptext name <> pprSize size <> space
-pprSizeImmOp :: Platform -> LitString -> Size -> Imm -> Operand -> SDoc
-pprSizeImmOp platform name size imm op1
+pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> SDoc
+pprSizeImmOp name size imm op1
= hcat [
pprMnemonic name size,
char '$',
- pprImm platform imm,
+ pprImm imm,
comma,
- pprOperand platform size op1
+ pprOperand size op1
]
-pprSizeOp :: Platform -> LitString -> Size -> Operand -> SDoc
-pprSizeOp platform name size op1
+pprSizeOp :: LitString -> Size -> Operand -> SDoc
+pprSizeOp name size op1
= hcat [
pprMnemonic name size,
- pprOperand platform size op1
+ pprOperand size op1
]
-pprSizeOpOp :: Platform -> LitString -> Size -> Operand -> Operand -> SDoc
-pprSizeOpOp platform name size op1 op2
+pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> SDoc
+pprSizeOpOp name size op1 op2
= hcat [
pprMnemonic name size,
- pprOperand platform size op1,
+ pprOperand size op1,
comma,
- pprOperand platform size op2
+ pprOperand size op2
]
-pprOpOp :: Platform -> LitString -> Size -> Operand -> Operand -> SDoc
-pprOpOp platform name size op1 op2
+pprOpOp :: LitString -> Size -> Operand -> Operand -> SDoc
+pprOpOp name size op1 op2
= hcat [
pprMnemonic_ name,
- pprOperand platform size op1,
+ pprOperand size op1,
comma,
- pprOperand platform size op2
+ pprOperand size op2
]
-pprSizeReg :: Platform -> LitString -> Size -> Reg -> SDoc
-pprSizeReg platform name size reg1
+pprSizeReg :: LitString -> Size -> Reg -> SDoc
+pprSizeReg name size reg1
= hcat [
pprMnemonic name size,
- pprReg platform size reg1
+ pprReg size reg1
]
-pprSizeRegReg :: Platform -> LitString -> Size -> Reg -> Reg -> SDoc
-pprSizeRegReg platform name size reg1 reg2
+pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> SDoc
+pprSizeRegReg name size reg1 reg2
= hcat [
pprMnemonic name size,
- pprReg platform size reg1,
+ pprReg size reg1,
comma,
- pprReg platform size reg2
+ pprReg size reg2
]
-pprRegReg :: Platform -> LitString -> Reg -> Reg -> SDoc
-pprRegReg platform name reg1 reg2
- = hcat [
+pprRegReg :: LitString -> Reg -> Reg -> SDoc
+pprRegReg name reg1 reg2
+ = sdocWithPlatform $ \platform ->
+ hcat [
pprMnemonic_ name,
- pprReg platform (archWordSize (target32Bit platform)) reg1,
+ pprReg (archWordSize (target32Bit platform)) reg1,
comma,
- pprReg platform (archWordSize (target32Bit platform)) reg2
+ pprReg (archWordSize (target32Bit platform)) reg2
]
-pprSizeOpReg :: Platform -> LitString -> Size -> Operand -> Reg -> SDoc
-pprSizeOpReg platform name size op1 reg2
- = hcat [
+pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> SDoc
+pprSizeOpReg name size op1 reg2
+ = sdocWithPlatform $ \platform ->
+ hcat [
pprMnemonic name size,
- pprOperand platform size op1,
+ pprOperand size op1,
comma,
- pprReg platform (archWordSize (target32Bit platform)) reg2
+ pprReg (archWordSize (target32Bit platform)) reg2
]
-pprCondRegReg :: Platform -> LitString -> Size -> Cond -> Reg -> Reg -> SDoc
-pprCondRegReg platform name size cond reg1 reg2
+pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> SDoc
+pprCondRegReg name size cond reg1 reg2
= hcat [
char '\t',
ptext name,
pprCond cond,
space,
- pprReg platform size reg1,
+ pprReg size reg1,
comma,
- pprReg platform size reg2
+ pprReg size reg2
]
-pprSizeSizeRegReg :: Platform -> LitString -> Size -> Size -> Reg -> Reg -> SDoc
-pprSizeSizeRegReg platform name size1 size2 reg1 reg2
+pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> SDoc
+pprSizeSizeRegReg name size1 size2 reg1 reg2
= hcat [
char '\t',
ptext name,
pprSize size1,
pprSize size2,
space,
- pprReg platform size1 reg1,
+ pprReg size1 reg1,
comma,
- pprReg platform size2 reg2
+ pprReg size2 reg2
]
-pprSizeSizeOpReg :: Platform -> LitString -> Size -> Size -> Operand -> Reg -> SDoc
-pprSizeSizeOpReg platform name size1 size2 op1 reg2
+pprSizeSizeOpReg :: LitString -> Size -> Size -> Operand -> Reg -> SDoc
+pprSizeSizeOpReg name size1 size2 op1 reg2
= hcat [
pprMnemonic name size2,
- pprOperand platform size1 op1,
+ pprOperand size1 op1,
comma,
- pprReg platform size2 reg2
+ pprReg size2 reg2
]
-pprSizeRegRegReg :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> SDoc
-pprSizeRegRegReg platform name size reg1 reg2 reg3
+pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> SDoc
+pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
pprMnemonic name size,
- pprReg platform size reg1,
+ pprReg size reg1,
comma,
- pprReg platform size reg2,
+ pprReg size reg2,
comma,
- pprReg platform size reg3
+ pprReg size reg3
]
-pprSizeAddrReg :: Platform -> LitString -> Size -> AddrMode -> Reg -> SDoc
-pprSizeAddrReg platform name size op dst
+pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> SDoc
+pprSizeAddrReg name size op dst
= hcat [
pprMnemonic name size,
- pprAddr platform op,
+ pprAddr op,
comma,
- pprReg platform size dst
+ pprReg size dst
]
-pprSizeRegAddr :: Platform -> LitString -> Size -> Reg -> AddrMode -> SDoc
-pprSizeRegAddr platform name size src op
+pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> SDoc
+pprSizeRegAddr name size src op
= hcat [
pprMnemonic name size,
- pprReg platform size src,
+ pprReg size src,
comma,
- pprAddr platform op
+ pprAddr op
]
-pprShift :: Platform -> LitString -> Size -> Operand -> Operand -> SDoc
-pprShift platform name size src dest
+pprShift :: LitString -> Size -> Operand -> Operand -> SDoc
+pprShift name size src dest
= hcat [
pprMnemonic name size,
- pprOperand platform II8 src, -- src is 8-bit sized
+ pprOperand II8 src, -- src is 8-bit sized
comma,
- pprOperand platform size dest
+ pprOperand size dest
]
-pprSizeOpOpCoerce :: Platform -> LitString -> Size -> Size -> Operand -> Operand -> SDoc
-pprSizeOpOpCoerce platform name size1 size2 op1 op2
+pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> SDoc
+pprSizeOpOpCoerce name size1 size2 op1 op2
= hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
- pprOperand platform size1 op1,
+ pprOperand size1 op1,
comma,
- pprOperand platform size2 op2
+ pprOperand size2 op2
]