-----------------------------------------------------------------------------
module PPC.Ppr (
- pprUserReg,
+ pprNatCmmTop,
+ pprBasicBlock,
+ pprSectionHeader,
+ pprData,
+ pprInstr,
pprSize,
pprImm,
- pprSectionHeader,
pprDataItem,
- pprInstr
)
where
#include "nativeGen/NCG.h"
#include "HsVersions.h"
-import RegsBase
-import PprBase
import PPC.Regs
import PPC.Instr
+import PPC.Cond
+import PprBase
+import Instruction
+import Size
+import Reg
+import RegClass
+import TargetReg
-import BlockId
-import Cmm
+import OldCmm
-import CLabel ( mkAsmTempLabel )
+import CLabel
-import Unique ( pprUnique )
+import Unique ( pprUnique, Uniquable(..) )
import Pretty
import FastString
import qualified Outputable
-import Outputable ( panic )
+import Outputable ( Outputable, panic )
-import Data.Word(Word32)
+import Data.Word
import Data.Bits
-pprUserReg :: Reg -> Doc
-pprUserReg = pprReg
+-- -----------------------------------------------------------------------------
+-- Printing this stuff out
+
+pprNatCmmTop :: NatCmmTop Instr -> Doc
+pprNatCmmTop (CmmData section dats) =
+ pprSectionHeader section $$ vcat (map pprData dats)
+
+ -- special case for split markers:
+pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl
+
+pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) =
+ pprSectionHeader Text $$
+ (if null info then -- blocks guaranteed not null, so label needed
+ pprLabel lbl
+ else
+#if HAVE_SUBSECTIONS_VIA_SYMBOLS
+ pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
+ <> char ':' $$
+#endif
+ vcat (map pprData info) $$
+ pprLabel (entryLblToInfoLbl lbl)
+ ) $$
+ 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 HAVE_SUBSECTIONS_VIA_SYMBOLS
+ -- If we are using the .subsections_via_symbols directive
+ -- (available on recent versions of Darwin),
+ -- we have to make sure that there is some kind of reference
+ -- from the entry code to a label on the _top_ of of the info table,
+ -- so that the linker will not think it is unreferenced and dead-strip
+ -- it. That's why the label is called a DeadStripPreventer (_dsp).
+ $$ if not (null info)
+ then text "\t.long "
+ <+> pprCLabel_asm (entryLblToInfoLbl lbl)
+ <+> char '-'
+ <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
+ else empty
+#endif
+
+
+pprBasicBlock :: NatBasicBlock Instr -> Doc
+pprBasicBlock (BasicBlock blockid instrs) =
+ pprLabel (mkAsmTempLabel (getUnique blockid)) $$
+ vcat (map pprInstr instrs)
+
+
+pprData :: CmmStatic -> Doc
+pprData (CmmAlign bytes) = pprAlign bytes
+pprData (CmmDataLabel lbl) = pprLabel lbl
+pprData (CmmString str) = pprASCII str
+
+#if darwin_TARGET_OS
+pprData (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes
+#else
+pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
+#endif
+
+pprData (CmmStaticLit lit) = pprDataItem lit
+
+pprGloblDecl :: CLabel -> Doc
+pprGloblDecl lbl
+ | not (externallyVisibleCLabel lbl) = empty
+ | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm lbl
+
+pprTypeAndSizeDecl :: CLabel -> Doc
+#if linux_TARGET_OS
+pprTypeAndSizeDecl lbl
+ | not (externallyVisibleCLabel lbl) = empty
+ | otherwise = ptext (sLit ".type ") <>
+ pprCLabel_asm lbl <> ptext (sLit ", @object")
+#else
+pprTypeAndSizeDecl _
+ = empty
+#endif
+
+pprLabel :: CLabel -> Doc
+pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
+
+
+pprASCII :: [Word8] -> Doc
+pprASCII str
+ = vcat (map do1 str) $$ do1 0
+ where
+ do1 :: Word8 -> Doc
+ do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
+
+pprAlign :: Int -> Doc
+pprAlign bytes =
+ ptext (sLit ".align ") <> int pow2
+ where
+ pow2 = log2 bytes
+
+ log2 :: Int -> Int -- cache the common ones
+ log2 1 = 0
+ log2 2 = 1
+ log2 4 = 2
+ log2 8 = 3
+ log2 n = 1 + log2 (n `quot` 2)
+
+
+-- -----------------------------------------------------------------------------
+-- pprInstr: print an 'Instr'
+
+instance Outputable Instr where
+ ppr instr = Outputable.docToSDoc $ pprInstr instr
+
pprReg :: Reg -> Doc
pprReg r
= case r of
- RealReg i -> ppr_reg_no i
- VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
- VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
- VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
- VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
+ RegReal (RealRegSingle i) -> ppr_reg_no i
+ RegReal (RealRegPair{}) -> panic "PPC.pprReg: no reg pairs on this arch"
+ RegVirtual (VirtualRegI u) -> text "%vI_" <> asmSDoc (pprUnique u)
+ RegVirtual (VirtualRegHi u) -> text "%vHi_" <> asmSDoc (pprUnique u)
+ RegVirtual (VirtualRegF u) -> text "%vF_" <> asmSDoc (pprUnique u)
+ RegVirtual (VirtualRegD u) -> text "%vD_" <> asmSDoc (pprUnique u)
+ RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
where
#if darwin_TARGET_OS
ppr_reg_no :: Int -> Doc
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(
+ IF_OS_linux(
((<>) (ptext (sLit "# ")) (ftext s)),
((<>) (ptext (sLit "; ")) (ftext s)))
- ,)))))
-}
pprInstr (DELTA d)
= pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
pprInstr (LDATA _ _)
= panic "PprMach.pprInstr: LDATA"
-
+{-
pprInstr (SPILL reg slot)
= hcat [
ptext (sLit "\tSPILL"),
ptext (sLit "SLOT") <> parens (int slot),
comma,
pprReg reg]
+-}
pprInstr (LD sz reg addr) = hcat [
char '\t',
| reg1 == reg2 = empty
| otherwise = hcat [
char '\t',
- case regClass reg1 of
+ case targetClassOfReg reg1 of
RcInteger -> ptext (sLit "mr")
_ -> ptext (sLit "fmr"),
char '\t',
RIReg _ -> empty
RIImm _ -> char 'i'
]
-pprInstr (BCC cond (BlockId id)) = hcat [
+pprInstr (BCC cond blockid) = hcat [
char '\t',
ptext (sLit "b"),
pprCond cond,
char '\t',
pprCLabel_asm lbl
]
- where lbl = mkAsmTempLabel id
+ where lbl = mkAsmTempLabel (getUnique blockid)
-pprInstr (BCCFAR cond (BlockId id)) = vcat [
+pprInstr (BCCFAR cond blockid) = vcat [
hcat [
ptext (sLit "\tb"),
pprCond (condNegate cond),
pprCLabel_asm lbl
]
]
- where lbl = mkAsmTempLabel id
+ where lbl = mkAsmTempLabel (getUnique blockid)
pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
char '\t',
char '\t',
pprReg reg
]
-pprInstr (BCTR _) = hcat [
+pprInstr (BCTR _ _) = hcat [
char '\t',
ptext (sLit "bctr")
]
projects / ghc-hetmet.git / blobdiff