pprSectionHeader,
pprData,
pprInstr,
- pprUserReg,
pprSize,
pprImm,
pprDataItem,
import PprBase
-import BlockId
-import Cmm
+import OldCmm
import CLabel
-import Config
-import Unique ( pprUnique )
+import Unique ( pprUnique, Uniquable(..) )
import Pretty
import FastString
import qualified Outputable
import Outputable (panic, Outputable)
import Data.Word
-import Distribution.System
#if i386_TARGET_ARCH && darwin_TARGET_OS
import Data.Bits
pprSectionHeader section $$ vcat (map pprData dats)
-- special case for split markers:
-pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl
+pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl
-pprNatCmmTop (CmmProc info lbl _ (ListGraph blocks)) =
+pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) =
pprSectionHeader Text $$
(if null info then -- blocks guaranteed not null, so label needed
pprLabel lbl
<+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
else empty
#endif
+ $$ pprSizeDecl (if null info then lbl else entryLblToInfoLbl lbl)
+-- | Output the ELF .size directive.
+pprSizeDecl :: CLabel -> Doc
+#if elf_OBJ_FORMAT
+pprSizeDecl lbl =
+ ptext (sLit "\t.size") <+> pprCLabel_asm lbl
+ <> ptext (sLit ", .-") <> pprCLabel_asm lbl
+#else
+pprSizeDecl _ = empty
+#endif
pprBasicBlock :: NatBasicBlock Instr -> Doc
-pprBasicBlock (BasicBlock (BlockId id) instrs) =
- pprLabel (mkAsmTempLabel id) $$
+pprBasicBlock (BasicBlock blockid instrs) =
+ pprLabel (mkAsmTempLabel (getUnique blockid)) $$
vcat (map pprInstr instrs)
pprGloblDecl :: CLabel -> Doc
pprGloblDecl lbl
| not (externallyVisibleCLabel lbl) = empty
- | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
- (sLit ".globl ")) <>
- pprCLabel_asm lbl
+ | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm lbl
pprTypeAndSizeDecl :: CLabel -> Doc
#if elf_OBJ_FORMAT
ppr instr = Outputable.docToSDoc $ pprInstr instr
-pprUserReg :: Reg -> Doc
-pprUserReg
- | cTargetArch == I386 = pprReg II32
- | cTargetArch == X86_64 = pprReg II64
- | otherwise = panic "X86.Ppr.pprUserReg: not defined"
-
pprReg :: Size -> Reg -> Doc
pprReg s r
pprInstr (COMMENT _) = empty -- nuke 'em
{-
-pprInstr (COMMENT s)
- = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
- ,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s))
- ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s))
- ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s))
- ,IF_ARCH_powerpc( IF_OS_linux(
- ((<>) (ptext (sLit "# ")) (ftext s)),
- ((<>) (ptext (sLit "; ")) (ftext s)))
- ,)))))
+pprInstr (COMMENT s) = ptext (sLit "# ") <> ftext s
-}
pprInstr (DELTA d)
= pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
pprInstr (SETCC cond op) = pprCondInstr (sLit "set") cond (pprOperand II8 op)
-pprInstr (JXX cond (BlockId id))
+pprInstr (JXX cond blockid)
= pprCondInstr (sLit "j") cond (pprCLabel_asm lab)
- where lab = mkAsmTempLabel id
+ where lab = mkAsmTempLabel (getUnique blockid)
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 archWordSize op)
-pprInstr (JMP_TBL op _) = pprInstr (JMP op)
+pprInstr (JMP_TBL op _ _ _) = pprInstr (JMP op)
pprInstr (CALL (Left imm) _) = (<>) (ptext (sLit "\tcall ")) (pprImm imm)
pprInstr (CALL (Right reg) _) = (<>) (ptext (sLit "\tcall *")) (pprReg archWordSize reg)
pprInstr (CVTSS2SD from to) = pprRegReg (sLit "cvtss2sd") from to
pprInstr (CVTSD2SS from to) = pprRegReg (sLit "cvtsd2ss") from to
-pprInstr (CVTTSS2SIQ sz from to) = pprSizeOpReg (sLit "cvttss2si") sz from to
-pprInstr (CVTTSD2SIQ sz from to) = pprSizeOpReg (sLit "cvttsd2si") sz 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
text " ; fildl (%esp) ; ",
gpop dst 1, text " ; addl $4,%esp"])
+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
on, here's the deal. Generate code to do a floating point comparison
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 (GCMP co src dst) = pprCondRegReg (sLit "gcmp_") FF64 co src dst
pprGInstr (GABS sz src dst) = pprSizeRegReg (sLit "gabs") sz src dst
pprReg archWordSize reg2
]
-
pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
pprCondRegReg name size cond reg1 reg2
= hcat [
pprSize size2,
space,
pprReg size1 reg1,
-
comma,
pprReg size2 reg2
]
+pprSizeSizeOpReg :: LitString -> Size -> Size -> Operand -> Reg -> Doc
+pprSizeSizeOpReg name size1 size2 op1 reg2
+ = hcat [
+ pprMnemonic name size2,
+ pprOperand size1 op1,
+ comma,
+ pprReg size2 reg2
+ ]
pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3