-----------------------------------------------------------------------------
--
-- Pretty-printing assembly language
--
-- (c) The University of Glasgow 1993-2005
--
-----------------------------------------------------------------------------

module PPC.Ppr (
	pprNatCmmTop,
	pprBasicBlock,
	pprSectionHeader,
	pprData,
	pprInstr,
	pprUserReg,
	pprSize,
	pprImm,
	pprDataItem,
)

where

#include "nativeGen/NCG.h"
#include "HsVersions.h"

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 CLabel

import Unique		( pprUnique )
import Pretty
import FastString
import qualified Outputable
import Outputable	( Outputable, panic )

import Data.Word
import Data.Bits


-- -----------------------------------------------------------------------------
-- 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 id) instrs) =
  pprLabel (mkAsmTempLabel id) $$
  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 IF_ARCH_sparc((sLit ".global "), 
				    (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


pprUserReg :: Reg -> Doc
pprUserReg = pprReg

pprReg :: Reg -> Doc

pprReg r
  = case r of
      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)
  where
#if darwin_TARGET_OS
    ppr_reg_no :: Int -> Doc
    ppr_reg_no i = ptext
      (case i of {
	 0 -> sLit "r0";   1 -> sLit "r1";
	 2 -> sLit "r2";   3 -> sLit "r3";
	 4 -> sLit "r4";   5 -> sLit "r5";
	 6 -> sLit "r6";   7 -> sLit "r7";
	 8 -> sLit "r8";   9 -> sLit "r9";
	10 -> sLit "r10";  11 -> sLit "r11";
	12 -> sLit "r12";  13 -> sLit "r13";
	14 -> sLit "r14";  15 -> sLit "r15";
	16 -> sLit "r16";  17 -> sLit "r17";
	18 -> sLit "r18";  19 -> sLit "r19";
	20 -> sLit "r20";  21 -> sLit "r21";
	22 -> sLit "r22";  23 -> sLit "r23";
	24 -> sLit "r24";  25 -> sLit "r25";
	26 -> sLit "r26";  27 -> sLit "r27";
	28 -> sLit "r28";  29 -> sLit "r29";
	30 -> sLit "r30";  31 -> sLit "r31";
	32 -> sLit "f0";  33 -> sLit "f1";
	34 -> sLit "f2";  35 -> sLit "f3";
	36 -> sLit "f4";  37 -> sLit "f5";
	38 -> sLit "f6";  39 -> sLit "f7";
	40 -> sLit "f8";  41 -> sLit "f9";
	42 -> sLit "f10"; 43 -> sLit "f11";
	44 -> sLit "f12"; 45 -> sLit "f13";
	46 -> sLit "f14"; 47 -> sLit "f15";
	48 -> sLit "f16"; 49 -> sLit "f17";
	50 -> sLit "f18"; 51 -> sLit "f19";
	52 -> sLit "f20"; 53 -> sLit "f21";
	54 -> sLit "f22"; 55 -> sLit "f23";
	56 -> sLit "f24"; 57 -> sLit "f25";
	58 -> sLit "f26"; 59 -> sLit "f27";
	60 -> sLit "f28"; 61 -> sLit "f29";
	62 -> sLit "f30"; 63 -> sLit "f31";
	_  -> sLit "very naughty powerpc register"
      })
#else
    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")
#endif



pprSize :: Size -> Doc
pprSize x 
 = ptext (case x of
		II8	-> sLit "b"
	        II16	-> sLit "h"
		II32	-> sLit "w"
		FF32	-> sLit "fs"
		FF64	-> sLit "fd"
		_	-> panic "PPC.Ppr.pprSize: no match")
		
		
pprCond :: Cond -> Doc
pprCond c 
 = ptext (case c of {
		ALWAYS  -> sLit "";
		EQQ	-> sLit "eq";	NE    -> sLit "ne";
		LTT     -> sLit "lt";  GE    -> sLit "ge";
		GTT     -> sLit "gt";  LE    -> sLit "le";
		LU      -> sLit "lt";  GEU   -> sLit "ge";
		GU      -> sLit "gt";  LEU   -> sLit "le"; })


pprImm :: Imm -> Doc

pprImm (ImmInt i)     = int i
pprImm (ImmInteger i) = integer i
pprImm (ImmCLbl l)    = pprCLabel_asm l
pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
pprImm (ImmLit s)     = s

pprImm (ImmFloat _)  = ptext (sLit "naughty float immediate")
pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")

pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
                            <> lparen <> pprImm b <> rparen

#if darwin_TARGET_OS
pprImm (LO i)
  = hcat [ pp_lo, pprImm i, rparen ]
  where
    pp_lo = text "lo16("

pprImm (HI i)
  = hcat [ pp_hi, pprImm i, rparen ]
  where
    pp_hi = text "hi16("

pprImm (HA i)
  = hcat [ pp_ha, pprImm i, rparen ]
  where
    pp_ha = text "ha16("
    
#else
pprImm (LO i)
  = pprImm i <> text "@l"

pprImm (HI i)
  = pprImm i <> text "@h"

pprImm (HA i)
  = pprImm i <> text "@ha"
#endif



pprAddr :: AddrMode -> Doc
pprAddr (AddrRegReg r1 r2)
  = pprReg r1 <+> ptext (sLit ", ") <+> pprReg r2

pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]


pprSectionHeader :: Section -> Doc
#if darwin_TARGET_OS 
pprSectionHeader seg
 = case seg of
 	Text			-> ptext (sLit ".text\n.align 2")
	Data			-> ptext (sLit ".data\n.align 2")
	ReadOnlyData		-> ptext (sLit ".const\n.align 2")
	RelocatableReadOnlyData	-> ptext (sLit ".const_data\n.align 2")
	UninitialisedData	-> ptext (sLit ".const_data\n.align 2")
	ReadOnlyData16		-> ptext (sLit ".const\n.align 4")
	OtherSection _		-> panic "PprMach.pprSectionHeader: unknown section"

#else
pprSectionHeader seg
 = case seg of
 	Text			-> ptext (sLit ".text\n.align 2")
	Data			-> ptext (sLit ".data\n.align 2")
	ReadOnlyData		-> ptext (sLit ".section .rodata\n\t.align 2")
	RelocatableReadOnlyData	-> ptext (sLit ".data\n\t.align 2")
	UninitialisedData	-> ptext (sLit ".section .bss\n\t.align 2")
	ReadOnlyData16		-> ptext (sLit ".section .rodata\n\t.align 4")
	OtherSection _		-> panic "PprMach.pprSectionHeader: unknown section"

#endif


pprDataItem :: CmmLit -> Doc
pprDataItem lit
  = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
    where
	imm = litToImm lit

	ppr_item II8   _ = [ptext (sLit "\t.byte\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 (ImmInt b)) bs

    	ppr_item FF64 (CmmFloat r _)
           = let bs = doubleToBytes (fromRational r)
             in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs

	ppr_item II16 _	= [ptext (sLit "\t.short\t") <> pprImm imm]

        ppr_item II64 (CmmInt x _)  =
                [ptext (sLit "\t.long\t")
                    <> int (fromIntegral 
                        (fromIntegral (x `shiftR` 32) :: Word32)),
                 ptext (sLit "\t.long\t")
                    <> int (fromIntegral (fromIntegral x :: Word32))]

	ppr_item _ _
		= panic "PPC.Ppr.pprDataItem: no match"


pprInstr :: Instr -> 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(
        ((<>) (ptext (sLit "# ")) (ftext s)),
        ((<>) (ptext (sLit "; ")) (ftext s)))
     ,)))))
-}
pprInstr (DELTA d)
   = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))

pprInstr (NEWBLOCK _)
   = panic "PprMach.pprInstr: NEWBLOCK"

pprInstr (LDATA _ _)
   = panic "PprMach.pprInstr: LDATA"

{-
pprInstr (SPILL reg slot)
   = hcat [
   	ptext (sLit "\tSPILL"),
	char '\t',
	pprReg reg,
	comma,
	ptext (sLit "SLOT") <> parens (int slot)]

pprInstr (RELOAD slot reg)
   = hcat [
   	ptext (sLit "\tRELOAD"),
	char '\t',
	ptext (sLit "SLOT") <> parens (int slot),
	comma,
	pprReg reg]
-}

pprInstr (LD sz reg addr) = hcat [
	char '\t',
	ptext (sLit "l"),
	ptext (case sz of
	    II8  -> sLit "bz"
	    II16 -> sLit "hz"
	    II32 -> sLit "wz"
	    FF32 -> sLit "fs"
	    FF64 -> sLit "fd"
	    _	 -> panic "PPC.Ppr.pprInstr: no match"
	    ),
        case addr of AddrRegImm _ _ -> empty
                     AddrRegReg _ _ -> char 'x',
	char '\t',
	pprReg reg,
	ptext (sLit ", "),
	pprAddr addr
    ]
pprInstr (LA sz reg addr) = hcat [
	char '\t',
	ptext (sLit "l"),
	ptext (case sz of
	    II8  -> sLit "ba"
	    II16 -> sLit "ha"
	    II32 -> sLit "wa"
	    FF32 -> sLit "fs"
	    FF64 -> sLit "fd"
	    _	 -> panic "PPC.Ppr.pprInstr: no match"
	    ),
        case addr of AddrRegImm _ _ -> empty
                     AddrRegReg _ _ -> char 'x',
	char '\t',
	pprReg reg,
	ptext (sLit ", "),
	pprAddr addr
    ]
pprInstr (ST sz reg addr) = hcat [
	char '\t',
	ptext (sLit "st"),
	pprSize sz,
        case addr of AddrRegImm _ _ -> empty
                     AddrRegReg _ _ -> char 'x',
	char '\t',
	pprReg reg,
	ptext (sLit ", "),
	pprAddr addr
    ]
pprInstr (STU sz reg addr) = hcat [
	char '\t',
	ptext (sLit "st"),
	pprSize sz,
	ptext (sLit "u\t"),
        case addr of AddrRegImm _ _ -> empty
                     AddrRegReg _ _ -> char 'x',
	pprReg reg,
	ptext (sLit ", "),
	pprAddr addr
    ]
pprInstr (LIS reg imm) = hcat [
	char '\t',
	ptext (sLit "lis"),
	char '\t',
	pprReg reg,
	ptext (sLit ", "),
	pprImm imm
    ]
pprInstr (LI reg imm) = hcat [
	char '\t',
	ptext (sLit "li"),
	char '\t',
	pprReg reg,
	ptext (sLit ", "),
	pprImm imm
    ]
pprInstr (MR reg1 reg2) 
    | reg1 == reg2 = empty
    | otherwise = hcat [
	char '\t',
	case targetClassOfReg reg1 of
	    RcInteger -> ptext (sLit "mr")
	    _ -> ptext (sLit "fmr"),
	char '\t',
	pprReg reg1,
	ptext (sLit ", "),
	pprReg reg2
    ]
pprInstr (CMP sz reg ri) = hcat [
	char '\t',
	op,
	char '\t',
	pprReg reg,
	ptext (sLit ", "),
	pprRI ri
    ]
    where
	op = hcat [
		ptext (sLit "cmp"),
		pprSize sz,
		case ri of
		    RIReg _ -> empty
		    RIImm _ -> char 'i'
	    ]
pprInstr (CMPL sz reg ri) = hcat [
	char '\t',
	op,
	char '\t',
	pprReg reg,
	ptext (sLit ", "),
	pprRI ri
    ]
    where
	op = hcat [
		ptext (sLit "cmpl"),
		pprSize sz,
		case ri of
		    RIReg _ -> empty
		    RIImm _ -> char 'i'
	    ]
pprInstr (BCC cond (BlockId id)) = hcat [
	char '\t',
	ptext (sLit "b"),
	pprCond cond,
	char '\t',
	pprCLabel_asm lbl
    ]
    where lbl = mkAsmTempLabel id

pprInstr (BCCFAR cond (BlockId id)) = vcat [
        hcat [
            ptext (sLit "\tb"),
            pprCond (condNegate cond),
            ptext (sLit "\t$+8")
        ],
        hcat [
            ptext (sLit "\tb\t"),
            pprCLabel_asm lbl
        ]
    ]
    where lbl = mkAsmTempLabel id

pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
	char '\t',
	ptext (sLit "b"),
	char '\t',
	pprCLabel_asm lbl
    ]

pprInstr (MTCTR reg) = hcat [
	char '\t',
	ptext (sLit "mtctr"),
	char '\t',
	pprReg reg
    ]
pprInstr (BCTR _) = hcat [
	char '\t',
	ptext (sLit "bctr")
    ]
pprInstr (BL lbl _) = hcat [
	ptext (sLit "\tbl\t"),
        pprCLabel_asm lbl
    ]
pprInstr (BCTRL _) = hcat [
	char '\t',
	ptext (sLit "bctrl")
    ]
pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
pprInstr (ADDIS reg1 reg2 imm) = hcat [
	char '\t',
	ptext (sLit "addis"),
	char '\t',
	pprReg reg1,
	ptext (sLit ", "),
	pprReg reg2,
	ptext (sLit ", "),
	pprImm imm
    ]

pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)

pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
         hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
                                          pprReg reg2, ptext (sLit ", "),
                                          pprReg reg3 ],
         hcat [ ptext (sLit "\tmfxer\t"),  pprReg reg1 ],
         hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
                                          pprReg reg1, ptext (sLit ", "),
                                          ptext (sLit "2, 31, 31") ]
    ]

    	-- for some reason, "andi" doesn't exist.
	-- we'll use "andi." instead.
pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
	char '\t',
	ptext (sLit "andi."),
	char '\t',
	pprReg reg1,
	ptext (sLit ", "),
	pprReg reg2,
	ptext (sLit ", "),
	pprImm imm
    ]
pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri

pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri

pprInstr (XORIS reg1 reg2 imm) = hcat [
	char '\t',
	ptext (sLit "xoris"),
	char '\t',
	pprReg reg1,
	ptext (sLit ", "),
	pprReg reg2,
	ptext (sLit ", "),
	pprImm imm
    ]

pprInstr (EXTS sz reg1 reg2) = hcat [
	char '\t',
	ptext (sLit "exts"),
	pprSize sz,
	char '\t',
	pprReg reg1,
	ptext (sLit ", "),
	pprReg reg2
    ]

pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2

pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
        ptext (sLit "\trlwinm\t"),
        pprReg reg1,
        ptext (sLit ", "),
        pprReg reg2,
        ptext (sLit ", "),
        int sh,
        ptext (sLit ", "),
        int mb,
        ptext (sLit ", "),
        int me
    ]
    
pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2

pprInstr (FCMP reg1 reg2) = hcat [
	char '\t',
	ptext (sLit "fcmpu\tcr0, "),
	    -- Note: we're using fcmpu, not fcmpo
	    -- The difference is with fcmpo, compare with NaN is an invalid operation.
	    -- We don't handle invalid fp ops, so we don't care
	pprReg reg1,
	ptext (sLit ", "),
	pprReg reg2
    ]

pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2

pprInstr (CRNOR dst src1 src2) = hcat [
        ptext (sLit "\tcrnor\t"),
        int dst,
        ptext (sLit ", "),
        int src1,
        ptext (sLit ", "),
        int src2
    ]

pprInstr (MFCR reg) = hcat [
	char '\t',
	ptext (sLit "mfcr"),
	char '\t',
	pprReg reg
    ]

pprInstr (MFLR reg) = hcat [
	char '\t',
	ptext (sLit "mflr"),
	char '\t',
	pprReg reg
    ]

pprInstr (FETCHPC reg) = vcat [
        ptext (sLit "\tbcl\t20,31,1f"),
        hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
    ]

pprInstr LWSYNC = ptext (sLit "\tlwsync")

-- pprInstr _ = panic "pprInstr (ppc)"


pprLogic :: LitString -> Reg -> Reg -> RI -> Doc
pprLogic op reg1 reg2 ri = hcat [
	char '\t',
	ptext op,
	case ri of
	    RIReg _ -> empty
	    RIImm _ -> char 'i',
	char '\t',
	pprReg reg1,
	ptext (sLit ", "),
	pprReg reg2,
	ptext (sLit ", "),
	pprRI ri
    ]


pprUnary :: LitString -> Reg -> Reg -> Doc    
pprUnary op reg1 reg2 = hcat [
	char '\t',
	ptext op,
	char '\t',
	pprReg reg1,
	ptext (sLit ", "),
	pprReg reg2
    ]
    
    
pprBinaryF :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprBinaryF op sz reg1 reg2 reg3 = hcat [
	char '\t',
	ptext op,
	pprFSize sz,
	char '\t',
	pprReg reg1,
	ptext (sLit ", "),
	pprReg reg2,
	ptext (sLit ", "),
	pprReg reg3
    ]
    
pprRI :: RI -> Doc
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r


pprFSize :: Size -> Doc
pprFSize FF64	= empty
pprFSize FF32	= char 's'
pprFSize _	= panic "PPC.Ppr.pprFSize: no match"

    -- limit immediate argument for shift instruction to range 0..32
    -- (yes, the maximum is really 32, not 31)
limitShiftRI :: RI -> RI
limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
limitShiftRI x = x