import BlockId
import Cmm
-import MachOp ( MachRep(..), wordRep, isFloatingRep )
import MachRegs -- may differ per-platform
import MachInstrs
pprLabel (entryLblToInfoLbl lbl)
) $$
vcat (map pprBasicBlock blocks)
- -- ^ Even the first block gets a label, because with branch-chain
+ -- above: Even the first block gets a label, because with branch-chain
-- elimination, it might be the target of a goto.
#if HAVE_SUBSECTIONS_VIA_SYMBOLS
-- If we are using the .subsections_via_symbols directive
-- on which bit of it we care about. Yurgh.
pprUserReg :: Reg -> Doc
-pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
+pprUserReg = pprReg IF_ARCH_i386(II32,) IF_ARCH_x86_64(II64,)
-pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
+pprReg :: IF_ARCH_i386(Size ->,) IF_ARCH_x86_64(Size ->,) Reg -> Doc
pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
= case r of
})
#endif
#if i386_TARGET_ARCH
- ppr_reg_no :: MachRep -> Int -> Doc
- ppr_reg_no I8 = ppr_reg_byte
- ppr_reg_no I16 = ppr_reg_word
+ ppr_reg_no :: Size -> Int -> Doc
+ ppr_reg_no II8 = ppr_reg_byte
+ ppr_reg_no II16 = ppr_reg_word
ppr_reg_no _ = ppr_reg_long
ppr_reg_byte i = ptext
#endif
#if x86_64_TARGET_ARCH
- ppr_reg_no :: MachRep -> Int -> Doc
- ppr_reg_no I8 = ppr_reg_byte
- ppr_reg_no I16 = ppr_reg_word
- ppr_reg_no I32 = ppr_reg_long
+ ppr_reg_no :: Size -> Int -> Doc
+ ppr_reg_no II8 = ppr_reg_byte
+ ppr_reg_no II16 = ppr_reg_word
+ ppr_reg_no II32 = ppr_reg_long
ppr_reg_no _ = ppr_reg_quad
ppr_reg_byte i = ptext
ppr_reg_no :: Int -> Doc
ppr_reg_no i | i <= 31 = int i -- GPRs
| i <= 63 = int (i-32) -- FPRs
- | otherwise = ptext sLit "very naughty powerpc register"
+ | otherwise = ptext (sLit "very naughty powerpc register")
#endif
#endif
-- pprSize: print a 'Size'
#if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
-pprSize :: MachRep -> Doc
+pprSize :: Size -> Doc
#else
pprSize :: Size -> Doc
#endif
TF -> sLit "t"
#endif
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
- I8 -> sLit "b"
- I16 -> sLit "w"
- I32 -> sLit "l"
- I64 -> sLit "q"
+ II8 -> sLit "b"
+ II16 -> sLit "w"
+ II32 -> sLit "l"
+ II64 -> sLit "q"
#endif
#if i386_TARGET_ARCH
- F32 -> sLit "s"
- F64 -> sLit "l"
- F80 -> sLit "t"
+ FF32 -> sLit "s"
+ FF64 -> sLit "l"
+ FF80 -> sLit "t"
#endif
#if x86_64_TARGET_ARCH
- F32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
- F64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
+ FF32 -> sLit "ss" -- "scalar single-precision float" (SSE2)
+ FF64 -> sLit "sd" -- "scalar double-precision float" (SSE2)
#endif
#if sparc_TARGET_ARCH
- I8 -> sLit "sb"
- I16 -> sLit "sh"
- I32 -> sLit ""
- F32 -> sLit ""
- F64 -> sLit "d"
+ II8 -> sLit "sb"
+ II16 -> sLit "sh"
+ II32 -> sLit ""
+ FF32 -> sLit ""
+ FF64 -> sLit "d"
)
-pprStSize :: MachRep -> Doc
+pprStSize :: Size -> Doc
pprStSize x = ptext (case x of
- I8 -> sLit "b"
- I16 -> sLit "h"
- I32 -> sLit ""
- F32 -> sLit ""
- F64 -> sLit "d"
+ II8 -> sLit "b"
+ II16 -> sLit "h"
+ II32 -> sLit ""
+ FF32 -> sLit ""
+ FF64 -> sLit "d"
#endif
#if powerpc_TARGET_ARCH
- I8 -> sLit "b"
- I16 -> sLit "h"
- I32 -> sLit "w"
- F32 -> sLit "fs"
- F64 -> sLit "fd"
+ II8 -> sLit "b"
+ II16 -> sLit "h"
+ II32 -> sLit "w"
+ FF32 -> sLit "fs"
+ FF64 -> sLit "fd"
#endif
)
pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
pprImm (ImmLit s) = s
-pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
+pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
= let
pp_disp = ppr_disp displacement
pp_off p = pp_disp <> char '(' <> p <> char ')'
- pp_reg r = pprReg wordRep r
+ pp_reg r = pprReg wordSize r
in
case (base,index) of
(EABaseNone, EAIndexNone) -> pp_disp
pprDataItem :: CmmLit -> Doc
pprDataItem lit
- = vcat (ppr_item (cmmLitRep lit) lit)
+ = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
where
imm = litToImm lit
-- These seem to be common:
- ppr_item I8 x = [ptext (sLit "\t.byte\t") <> pprImm imm]
- ppr_item I32 x = [ptext (sLit "\t.long\t") <> pprImm imm]
- ppr_item F32 (CmmFloat r _)
+ ppr_item II8 x = [ptext (sLit "\t.byte\t") <> pprImm imm]
+ ppr_item II32 x = [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 (ImmInt b)) bs
- ppr_item F64 (CmmFloat r _)
+ ppr_item FF64 (CmmFloat r _)
= let bs = doubleToBytes (fromRational r)
in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
#if sparc_TARGET_ARCH
-- copy n paste of x86 version
- ppr_item I16 x = [ptext (sLit "\t.short\t") <> pprImm imm]
- ppr_item I64 x = [ptext (sLit "\t.quad\t") <> pprImm imm]
+ ppr_item II16 x = [ptext (sLit "\t.short\t") <> pprImm imm]
+ ppr_item II64 x = [ptext (sLit "\t.quad\t") <> pprImm imm]
#endif
#if i386_TARGET_ARCH || x86_64_TARGET_ARCH
- ppr_item I16 x = [ptext (sLit "\t.word\t") <> pprImm imm]
+ ppr_item II16 x = [ptext (sLit "\t.word\t") <> pprImm imm]
#endif
#if i386_TARGET_ARCH && darwin_TARGET_OS
- ppr_item I64 (CmmInt x _) =
+ ppr_item II64 (CmmInt x _) =
[ptext (sLit "\t.long\t")
<> int (fromIntegral (fromIntegral x :: Word32)),
ptext (sLit "\t.long\t")
(fromIntegral (x `shiftR` 32) :: Word32))]
#endif
#if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
- ppr_item I64 x = [ptext (sLit "\t.quad\t") <> pprImm imm]
+ ppr_item II64 x = [ptext (sLit "\t.quad\t") <> pprImm imm]
#endif
#if x86_64_TARGET_ARCH && !darwin_TARGET_OS
-- x86_64: binutils can't handle the R_X86_64_PC64 relocation
--
-- See Note [x86-64-relative] in includes/InfoTables.h
--
- ppr_item I64 x
+ ppr_item II64 x
| isRelativeReloc x =
[ptext (sLit "\t.long\t") <> pprImm imm,
ptext (sLit "\t.long\t0")]
isRelativeReloc _ = False
#endif
#if powerpc_TARGET_ARCH
- ppr_item I16 x = [ptext (sLit "\t.short\t") <> pprImm imm]
- ppr_item I64 (CmmInt x _) =
+ ppr_item II16 x = [ptext (sLit "\t.short\t") <> pprImm imm]
+ ppr_item II64 (CmmInt x _) =
[ptext (sLit "\t.long\t")
<> int (fromIntegral
(fromIntegral (x `shiftR` 32) :: Word32)),
pprInstr (MOV size src dst)
= pprSizeOpOp (sLit "mov") size src dst
-pprInstr (MOVZxL I32 src dst) = pprSizeOpOp (sLit "mov") I32 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 (MOVZxL sizes src dst) = pprSizeOpOpCoerce (sLit "movz") sizes I32 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 (MOVSxL sizes src dst) = pprSizeOpOpCoerce (sLit "movs") sizes wordRep src dst
+pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce (sLit "movs") sizes wordSize src dst
-- here we do some patching, since the physical registers are only set late
-- in the code generation.
pprInstr (AND size src dst) = pprSizeOpOp (sLit "and") size src dst
pprInstr (OR size src dst) = pprSizeOpOp (sLit "or") size src dst
-pprInstr (XOR F32 src dst) = pprOpOp (sLit "xorps") F32 src dst
-pprInstr (XOR F64 src dst) = pprOpOp (sLit "xorpd") F64 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 (NOT size op) = pprSizeOp (sLit "not") size op
pprInstr (BT size imm src) = pprSizeImmOp (sLit "bt") size imm src
pprInstr (CMP size src dst)
- | isFloatingRep size = pprSizeOpOp (sLit "ucomi") size src dst -- SSE2
- | otherwise = pprSizeOpOp (sLit "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
+ is_float FF64 = True
+ is_float FF80 = True
+ is_float other = False
pprInstr (TEST size src dst) = pprSizeOpOp (sLit "test") size src dst
pprInstr (PUSH size op) = pprSizeOp (sLit "push") size op
-- pprInstr POPA = ptext (sLit "\tpopal")
pprInstr NOP = ptext (sLit "\tnop")
-pprInstr (CLTD I32) = ptext (sLit "\tcltd")
-pprInstr (CLTD I64) = ptext (sLit "\tcqto")
+pprInstr (CLTD II32) = ptext (sLit "\tcltd")
+pprInstr (CLTD II64) = ptext (sLit "\tcqto")
-pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand I8 op)
+pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
pprInstr (JXX cond (BlockId id))
= pprCondInstr (sLit "j") cond (pprCLabel_asm lab)
pprInstr (JXX_GBL cond imm) = pprCondInstr (sLit "j") cond (pprImm imm)
pprInstr (JMP (OpImm imm)) = (<>) (ptext (sLit "\tjmp ")) (pprImm imm)
-pprInstr (JMP op) = (<>) (ptext (sLit "\tjmp *")) (pprOperand wordRep op)
+pprInstr (JMP op) = (<>) (ptext (sLit "\tjmp *")) (pprOperand wordSize op)
pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
-pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg wordRep reg)
+pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg wordSize reg)
pprInstr (IDIV sz op) = pprSizeOp (sLit "idiv") sz op
pprInstr (DIV sz op) = pprSizeOp (sLit "div") sz op
-- FETCHGOT for PIC on ELF platforms
pprInstr (FETCHGOT reg)
= vcat [ ptext (sLit "\tcall 1f"),
- hcat [ ptext (sLit "1:\tpopl\t"), pprReg I32 reg ],
+ hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ],
hcat [ ptext (sLit "\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
- pprReg I32 reg ]
+ pprReg II32 reg ]
]
-- FETCHPC for PIC on Darwin/x86
-- and it's a good thing to use the same name on both platforms)
pprInstr (FETCHPC reg)
= vcat [ ptext (sLit "\tcall 1f"),
- hcat [ ptext (sLit "1:\tpopl\t"), pprReg I32 reg ]
+ hcat [ ptext (sLit "1:\tpopl\t"), pprReg II32 reg ]
]
hcat [gtab, text "addl $8, %esp"]
])
where
- reg = pprReg I32 dst
+ reg = pprReg II32 dst
pprInstr g@(GITOF src dst)
= pprInstr (GITOD src dst)
pprInstr g@(GITOD src dst)
- = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
+ = pprG g (hcat [gtab, text "pushl ", pprReg II32 src,
text " ; ffree %st(7); fildl (%esp) ; ",
gpop dst 1, text " ; addl $4,%esp"])
ptext (sLit "\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
]
-pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> MachRep -> Doc
+pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Size -> Doc
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
--------------------------
-- coerce %st(0) to the specified size
-gcoerceto F64 = empty
-gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
+gcoerceto FF64 = empty
+gcoerceto FF32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
gpush reg offset
= hcat [text "ffree %st(7) ; fld ", greg reg offset]
pprG fake actual
= (char '#' <> pprGInstr fake) $$ actual
-pprGInstr (GMOV src dst) = pprSizeRegReg (sLit "gmov") F64 src dst
+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 (GLDZ dst) = pprSizeReg (sLit "gldz") F64 dst
-pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") F64 dst
+pprGInstr (GLDZ dst) = pprSizeReg (sLit "gldz") FF64 dst
+pprGInstr (GLD1 dst) = pprSizeReg (sLit "gld1") FF64 dst
-pprGInstr (GFTOI src dst) = pprSizeSizeRegReg (sLit "gftoi") F32 I32 src dst
-pprGInstr (GDTOI src dst) = pprSizeSizeRegReg (sLit "gdtoi") F64 I32 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 (GITOF src dst) = pprSizeSizeRegReg (sLit "gitof") I32 F32 src dst
-pprGInstr (GITOD src dst) = pprSizeSizeRegReg (sLit "gitod") I32 F64 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 (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") F64 co 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
pprDollImm i = ptext (sLit "$") <> pprImm i
-pprOperand :: MachRep -> Operand -> Doc
+pprOperand :: Size -> Operand -> Doc
pprOperand s (OpReg r) = pprReg s r
pprOperand s (OpImm i) = pprDollImm i
pprOperand s (OpAddr ea) = pprAddr ea
pprMnemonic_ name =
char '\t' <> ptext name <> space
-pprMnemonic :: LitString -> MachRep -> Doc
+pprMnemonic :: LitString -> Size -> Doc
pprMnemonic name size =
char '\t' <> ptext name <> pprSize size <> space
-pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
+pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
pprSizeImmOp name size imm op1
= hcat [
pprMnemonic name size,
pprOperand size op1
]
-pprSizeOp :: LitString -> MachRep -> Operand -> Doc
+pprSizeOp :: LitString -> Size -> Operand -> Doc
pprSizeOp name size op1
= hcat [
pprMnemonic name size,
pprOperand size op1
]
-pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
+pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
pprSizeOpOp name size op1 op2
= hcat [
pprMnemonic name size,
pprOperand size op2
]
-pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
+pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
pprOpOp name size op1 op2
= hcat [
pprMnemonic_ name,
pprOperand size op2
]
-pprSizeReg :: LitString -> MachRep -> Reg -> Doc
+pprSizeReg :: LitString -> Size -> Reg -> Doc
pprSizeReg name size reg1
= hcat [
pprMnemonic name size,
pprReg size reg1
]
-pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
+pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
pprSizeRegReg name size reg1 reg2
= hcat [
pprMnemonic name size,
pprRegReg name reg1 reg2
= hcat [
pprMnemonic_ name,
- pprReg wordRep reg1,
+ pprReg wordSize reg1,
comma,
- pprReg wordRep reg2
+ pprReg wordSize reg2
]
pprOpReg :: LitString -> Operand -> Reg -> Doc
pprOpReg name op1 reg2
= hcat [
pprMnemonic_ name,
- pprOperand wordRep op1,
+ pprOperand wordSize op1,
comma,
- pprReg wordRep reg2
+ pprReg wordSize reg2
]
-pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
+pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
pprCondRegReg name size cond reg1 reg2
= hcat [
char '\t',
pprReg size reg2
]
-pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
+pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
pprSizeSizeRegReg name size1 size2 reg1 reg2
= hcat [
char '\t',
pprReg size2 reg2
]
-pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
+pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
pprMnemonic name size,
pprReg size reg3
]
-pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
+pprSizeAddrReg :: LitString -> Size -> AddrMode -> Reg -> Doc
pprSizeAddrReg name size op dst
= hcat [
pprMnemonic name size,
pprReg size dst
]
-pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
+pprSizeRegAddr :: LitString -> Size -> Reg -> AddrMode -> Doc
pprSizeRegAddr name size src op
= hcat [
pprMnemonic name size,
pprAddr op
]
-pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
+pprShift :: LitString -> Size -> Operand -> Operand -> Doc
pprShift name size src dest
= hcat [
pprMnemonic name size,
- pprOperand I8 src, -- src is 8-bit sized
+ pprOperand II8 src, -- src is 8-bit sized
comma,
pprOperand size dest
]
-pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
+pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
pprSizeOpOpCoerce name size1 size2 op1 op2
= hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
pprOperand size1 op1,
-- ld [g1+4],%f(n+1)
-- sub g1,g2,g1 -- to restore g1
-pprInstr (LD F64 (AddrRegReg g1 g2) reg)
+pprInstr (LD FF64 (AddrRegReg g1 g2) reg)
= vcat [
hcat [ptext (sLit "\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
-- Translate to
-- ld [addr],%fn
-- ld [addr+4],%f(n+1)
-pprInstr (LD F64 addr reg) | isJust off_addr
+pprInstr (LD FF64 addr reg) | isJust off_addr
= vcat [
hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
-- st %fn,[g1]
-- st %f(n+1),[g1+4]
-- sub g1,g2,g1 -- to restore g1
-pprInstr (ST F64 reg (AddrRegReg g1 g2))
+pprInstr (ST FF64 reg (AddrRegReg g1 g2))
= vcat [
hcat [ptext (sLit "\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
hcat [ptext (sLit "\tst\t"), pprReg reg, pp_comma_lbracket,
-- Translate to
-- st %fn,[addr]
-- st %f(n+1),[addr+4]
-pprInstr (ST F64 reg addr) | isJust off_addr
+pprInstr (ST FF64 reg addr) | isJust off_addr
= vcat [
hcat [ptext (sLit "\tst\t"), pprReg reg, pp_comma_lbracket,
pprAddr addr, rbrack],
pprInstr NOP = ptext (sLit "\tnop")
-pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg (sLit "fabs") F32 reg1 reg2
-pprInstr (FABS F64 reg1 reg2)
- = (<>) (pprSizeRegReg (sLit "fabs") F32 reg1 reg2)
+pprInstr (FABS FF32 reg1 reg2) = pprSizeRegReg (sLit "fabs") FF32 reg1 reg2
+pprInstr (FABS FF64 reg1 reg2)
+ = (<>) (pprSizeRegReg (sLit "fabs") FF32 reg1 reg2)
(if (reg1 == reg2) then empty
else (<>) (char '\n')
- (pprSizeRegReg (sLit "fmov") F32 (fPair reg1) (fPair reg2)))
+ (pprSizeRegReg (sLit "fmov") FF32 (fPair reg1) (fPair reg2)))
pprInstr (FADD size reg1 reg2 reg3)
= pprSizeRegRegReg (sLit "fadd") size reg1 reg2 reg3
pprInstr (FDIV size reg1 reg2 reg3)
= pprSizeRegRegReg (sLit "fdiv") size reg1 reg2 reg3
-pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg (sLit "fmov") F32 reg1 reg2
-pprInstr (FMOV F64 reg1 reg2)
- = (<>) (pprSizeRegReg (sLit "fmov") F32 reg1 reg2)
+pprInstr (FMOV FF32 reg1 reg2) = pprSizeRegReg (sLit "fmov") FF32 reg1 reg2
+pprInstr (FMOV FF64 reg1 reg2)
+ = (<>) (pprSizeRegReg (sLit "fmov") FF32 reg1 reg2)
(if (reg1 == reg2) then empty
else (<>) (char '\n')
- (pprSizeRegReg (sLit "fmov") F32 (fPair reg1) (fPair reg2)))
+ (pprSizeRegReg (sLit "fmov") FF32 (fPair reg1) (fPair reg2)))
pprInstr (FMUL size reg1 reg2 reg3)
= pprSizeRegRegReg (sLit "fmul") size reg1 reg2 reg3
-pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg (sLit "fneg") F32 reg1 reg2
-pprInstr (FNEG F64 reg1 reg2)
- = (<>) (pprSizeRegReg (sLit "fneg") F32 reg1 reg2)
+pprInstr (FNEG FF32 reg1 reg2) = pprSizeRegReg (sLit "fneg") FF32 reg1 reg2
+pprInstr (FNEG FF64 reg1 reg2)
+ = (<>) (pprSizeRegReg (sLit "fneg") FF32 reg1 reg2)
(if (reg1 == reg2) then empty
else (<>) (char '\n')
- (pprSizeRegReg (sLit "fmov") F32 (fPair reg1) (fPair reg2)))
+ (pprSizeRegReg (sLit "fmov") FF32 (fPair reg1) (fPair reg2)))
pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg (sLit "fsqrt") size reg1 reg2
pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "fsub") size reg1 reg2 reg3
ptext (sLit "\tf"),
ptext
(case size1 of
- I32 -> sLit "ito"
- F32 -> sLit "sto"
- F64 -> sLit "dto"),
+ II32 -> sLit "ito"
+ FF32 -> sLit "sto"
+ FF64 -> sLit "dto"),
ptext
(case size2 of
- I32 -> sLit "i\t"
- F32 -> sLit "s\t"
- F64 -> sLit "d\t"),
+ II32 -> sLit "i\t"
+ FF32 -> sLit "s\t"
+ FF64 -> sLit "d\t"),
pprReg reg1, comma, pprReg reg2
]
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r
-pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
+pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
pprSizeRegReg name size reg1 reg2
= hcat [
char '\t',
ptext name,
(case size of
- F32 -> ptext (sLit "s\t")
- F64 -> ptext (sLit "d\t")),
+ FF32 -> ptext (sLit "s\t")
+ FF64 -> ptext (sLit "d\t")),
pprReg reg1,
comma,
pprReg reg2
]
-pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
+pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
char '\t',
ptext name,
(case size of
- F32 -> ptext (sLit "s\t")
- F64 -> ptext (sLit "d\t")),
+ FF32 -> ptext (sLit "s\t")
+ FF64 -> ptext (sLit "d\t")),
pprReg reg1,
comma,
pprReg reg2,
char '\t',
ptext (sLit "l"),
ptext (case sz of
- I8 -> sLit "bz"
- I16 -> sLit "hz"
- I32 -> sLit "wz"
- F32 -> sLit "fs"
- F64 -> sLit "fd"),
+ II8 -> sLit "bz"
+ II16 -> sLit "hz"
+ II32 -> sLit "wz"
+ FF32 -> sLit "fs"
+ FF64 -> sLit "fd"),
case addr of AddrRegImm _ _ -> empty
AddrRegReg _ _ -> char 'x',
char '\t',
char '\t',
ptext (sLit "l"),
ptext (case sz of
- I8 -> sLit "ba"
- I16 -> sLit "ha"
- I32 -> sLit "wa"
- F32 -> sLit "fs"
- F64 -> sLit "fd"),
+ II8 -> sLit "ba"
+ II16 -> sLit "ha"
+ II32 -> sLit "wa"
+ FF32 -> sLit "fs"
+ FF64 -> sLit "fd"),
case addr of AddrRegImm _ _ -> empty
AddrRegReg _ _ -> char 'x',
char '\t',
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r
-pprFSize F64 = empty
-pprFSize F32 = char 's'
+pprFSize FF64 = empty
+pprFSize FF32 = char 's'
-- limit immediate argument for shift instruction to range 0..32
-- (yes, the maximum is really 32, not 31)