
module Alpha.Ppr (
{-
	pprReg,
	pprSize,
	pprCond,
	pprAddr,
	pprSectionHeader,
	pprTypeAndSizeDecl,
	pprRI,
	pprRegRIReg,
	pprSizeRegRegReg
-}
)

where

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

import BlockId
import Cmm
import Regs		-- may differ per-platform
import Instrs

import CLabel		( CLabel, pprCLabel, externallyVisibleCLabel,
			  labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )

#if HAVE_SUBSECTIONS_VIA_SYMBOLS
import CLabel       ( mkDeadStripPreventer )
#endif

import Panic		( panic )
import Unique		( pprUnique )
import Pretty
import FastString
import qualified Outputable
import Outputable	( Outputable, pprPanic, ppr, docToSDoc)

import Data.Array.ST
import Data.Word	( Word8 )
import Control.Monad.ST
import Data.Char	( chr, ord )
import Data.Maybe       ( isJust )



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)
  where
    ppr_reg_no :: Int -> Doc
    ppr_reg_no i = ptext
      (case i of {
	 0 -> sLit "$0";    1 -> sLit "$1";
	 2 -> sLit "$2";    3 -> sLit "$3";
	 4 -> sLit "$4";    5 -> sLit "$5";
	 6 -> sLit "$6";    7 -> sLit "$7";
	 8 -> sLit "$8";    9 -> sLit "$9";
	10 -> sLit "$10";  11 -> sLit "$11";
	12 -> sLit "$12";  13 -> sLit "$13";
	14 -> sLit "$14";  15 -> sLit "$15";
	16 -> sLit "$16";  17 -> sLit "$17";
	18 -> sLit "$18";  19 -> sLit "$19";
	20 -> sLit "$20";  21 -> sLit "$21";
	22 -> sLit "$22";  23 -> sLit "$23";
	24 -> sLit "$24";  25 -> sLit "$25";
	26 -> sLit "$26";  27 -> sLit "$27";
	28 -> sLit "$28";  29 -> sLit "$29";
	30 -> sLit "$30";  31 -> sLit "$31";
	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 alpha register"
      })


pprSize :: Size -> Doc
pprSize x = ptext (case x of
	 B  -> sLit "b"
	 Bu -> sLit "bu"
--	 W  -> sLit "w" UNUSED
--	 Wu -> sLit "wu" UNUSED
	 L  -> sLit "l"
	 Q  -> sLit "q"
--	 FF -> sLit "f" UNUSED
--	 DF -> sLit "d" UNUSED
--	 GF -> sLit "g" UNUSED
--	 SF -> sLit "s" UNUSED
	 TF -> sLit "t"


pprCond :: Cond -> Doc
pprCond c 
 = ptext (case c of
		EQQ  -> sLit "eq"
		LTT  -> sLit "lt"
		LE  -> sLit "le"
		ULT -> sLit "ult"
		ULE -> sLit "ule"
		NE  -> sLit "ne"
		GTT  -> sLit "gt"
		GE  -> sLit "ge")


pprAddr :: AddrMode -> Doc
pprAddr (AddrReg r) = parens (pprReg r)
pprAddr (AddrImm i) = pprImm i
pprAddr (AddrRegImm r1 i)
  = (<>) (pprImm i) (parens (pprReg r1))


pprSectionHeader Text
    = ptext	(sLit "\t.text\n\t.align 3")

pprSectionHeader Data
    = ptext	(sLit "\t.data\n\t.align 3")

pprSectionHeader ReadOnlyData
    = ptext	(sLit "\t.data\n\t.align 3")

pprSectionHeader RelocatableReadOnlyData
    = ptext	(sLit "\t.data\n\t.align 3")

pprSectionHeader UninitialisedData
    = ptext	(sLit "\t.bss\n\t.align 3")

pprSectionHeader ReadOnlyData16
    = ptext	(sLit "\t.data\n\t.align 4")

pprSectionHeader (OtherSection sec)
    = panic "PprMach.pprSectionHeader: unknown section"


pprTypeAndSizeDecl :: CLabel -> Doc
pprTypeAndSizeDecl lbl
  = empty



pprInstr :: Instr -> Doc

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 size reg addr)
  = hcat [
	ptext (sLit "\tld"),
	pprSize size,
	char '\t',
	pprReg reg,
	comma,
	pprAddr addr
    ]

pprInstr (LDA reg addr)
  = hcat [
	ptext (sLit "\tlda\t"),
	pprReg reg,
	comma,
	pprAddr addr
    ]

pprInstr (LDAH reg addr)
  = hcat [
	ptext (sLit "\tldah\t"),
	pprReg reg,
	comma,
	pprAddr addr
    ]

pprInstr (LDGP reg addr)
  = hcat [
	ptext (sLit "\tldgp\t"),
	pprReg reg,
	comma,
	pprAddr addr
    ]

pprInstr (LDI size reg imm)
  = hcat [
	ptext (sLit "\tldi"),
	pprSize size,
	char '\t',
	pprReg reg,
	comma,
	pprImm imm
    ]

pprInstr (ST size reg addr)
  = hcat [
	ptext (sLit "\tst"),
	pprSize size,
	char '\t',
	pprReg reg,
	comma,
	pprAddr addr
    ]

pprInstr (CLR reg)
  = hcat [
	ptext (sLit "\tclr\t"),
	pprReg reg
    ]

pprInstr (ABS size ri reg)
  = hcat [
	ptext (sLit "\tabs"),
	pprSize size,
	char '\t',
	pprRI ri,
	comma,
	pprReg reg
    ]

pprInstr (NEG size ov ri reg)
  = hcat [
	ptext (sLit "\tneg"),
	pprSize size,
	if ov then ptext (sLit "v\t") else char '\t',
	pprRI ri,
	comma,
	pprReg reg
    ]

pprInstr (ADD size ov reg1 ri reg2)
  = hcat [
	ptext (sLit "\tadd"),
	pprSize size,
	if ov then ptext (sLit "v\t") else char '\t',
	pprReg reg1,
	comma,
	pprRI ri,
	comma,
	pprReg reg2
    ]

pprInstr (SADD size scale reg1 ri reg2)
  = hcat [
	ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
	ptext (sLit "add"),
	pprSize size,
	char '\t',
	pprReg reg1,
	comma,
	pprRI ri,
	comma,
	pprReg reg2
    ]

pprInstr (SUB size ov reg1 ri reg2)
  = hcat [
	ptext (sLit "\tsub"),
	pprSize size,
	if ov then ptext (sLit "v\t") else char '\t',
	pprReg reg1,
	comma,
	pprRI ri,
	comma,
	pprReg reg2
    ]

pprInstr (SSUB size scale reg1 ri reg2)
  = hcat [
	ptext (case scale of {{-UNUSED:L -> (sLit "\ts4");-} Q -> (sLit "\ts8")}),
	ptext (sLit "sub"),
	pprSize size,
	char '\t',
	pprReg reg1,
	comma,
	pprRI ri,
	comma,
	pprReg reg2
    ]

pprInstr (MUL size ov reg1 ri reg2)
  = hcat [
	ptext (sLit "\tmul"),
	pprSize size,
	if ov then ptext (sLit "v\t") else char '\t',
	pprReg reg1,
	comma,
	pprRI ri,
	comma,
	pprReg reg2
    ]

pprInstr (DIV size uns reg1 ri reg2)
  = hcat [
	ptext (sLit "\tdiv"),
	pprSize size,
	if uns then ptext (sLit "u\t") else char '\t',
	pprReg reg1,
	comma,
	pprRI ri,
	comma,
	pprReg reg2
    ]

pprInstr (REM size uns reg1 ri reg2)
  = hcat [
	ptext (sLit "\trem"),
	pprSize size,
	if uns then ptext (sLit "u\t") else char '\t',
	pprReg reg1,
	comma,
	pprRI ri,
	comma,
	pprReg reg2
    ]

pprInstr (NOT ri reg)
  = hcat [
	ptext (sLit "\tnot"),
	char '\t',
	pprRI ri,
	comma,
	pprReg reg
    ]

pprInstr (AND reg1 ri reg2) = pprRegRIReg (sLit "and") reg1 ri reg2
pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg (sLit "andnot") reg1 ri reg2
pprInstr (OR reg1 ri reg2) = pprRegRIReg (sLit "or") reg1 ri reg2
pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg (sLit "ornot") reg1 ri reg2
pprInstr (XOR reg1 ri reg2) = pprRegRIReg (sLit "xor") reg1 ri reg2
pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg (sLit "xornot") reg1 ri reg2

pprInstr (SLL reg1 ri reg2) = pprRegRIReg (sLit "sll") reg1 ri reg2
pprInstr (SRL reg1 ri reg2) = pprRegRIReg (sLit "srl") reg1 ri reg2
pprInstr (SRA reg1 ri reg2) = pprRegRIReg (sLit "sra") reg1 ri reg2

pprInstr (ZAP reg1 ri reg2) = pprRegRIReg (sLit "zap") reg1 ri reg2
pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg (sLit "zapnot") reg1 ri reg2

pprInstr (NOP) = ptext (sLit "\tnop")

pprInstr (CMP cond reg1 ri reg2)
  = hcat [
	ptext (sLit "\tcmp"),
	pprCond cond,
	char '\t',
	pprReg reg1,
	comma,
	pprRI ri,
	comma,
	pprReg reg2
    ]

pprInstr (FCLR reg)
  = hcat [
	ptext (sLit "\tfclr\t"),
	pprReg reg
    ]

pprInstr (FABS reg1 reg2)
  = hcat [
	ptext (sLit "\tfabs\t"),
	pprReg reg1,
	comma,
	pprReg reg2
    ]

pprInstr (FNEG size reg1 reg2)
  = hcat [
	ptext (sLit "\tneg"),
	pprSize size,
	char '\t',
	pprReg reg1,
	comma,
	pprReg reg2
    ]

pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "add") size reg1 reg2 reg3
pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "div") size reg1 reg2 reg3
pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "mul") size reg1 reg2 reg3
pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg (sLit "sub") size reg1 reg2 reg3

pprInstr (CVTxy size1 size2 reg1 reg2)
  = hcat [
	ptext (sLit "\tcvt"),
	pprSize size1,
	case size2 of {Q -> ptext (sLit "qc"); _ -> pprSize size2},
	char '\t',
	pprReg reg1,
	comma,
	pprReg reg2
    ]

pprInstr (FCMP size cond reg1 reg2 reg3)
  = hcat [
	ptext (sLit "\tcmp"),
	pprSize size,
	pprCond cond,
	char '\t',
	pprReg reg1,
	comma,
	pprReg reg2,
	comma,
	pprReg reg3
    ]

pprInstr (FMOV reg1 reg2)
  = hcat [
	ptext (sLit "\tfmov\t"),
	pprReg reg1,
	comma,
	pprReg reg2
    ]

pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)

pprInstr (BI NEVER reg lab) = empty

pprInstr (BI cond reg lab)
  = hcat [
	ptext (sLit "\tb"),
	pprCond cond,
	char '\t',
	pprReg reg,
	comma,
	pprImm lab
    ]

pprInstr (BF cond reg lab)
  = hcat [
	ptext (sLit "\tfb"),
	pprCond cond,
	char '\t',
	pprReg reg,
	comma,
	pprImm lab
    ]

pprInstr (BR lab)
  = (<>) (ptext (sLit "\tbr\t")) (pprImm lab)

pprInstr (JMP reg addr hint)
  = hcat [
	ptext (sLit "\tjmp\t"),
	pprReg reg,
	comma,
	pprAddr addr,
	comma,
	int hint
    ]

pprInstr (BSR imm n)
  = (<>) (ptext (sLit "\tbsr\t")) (pprImm imm)

pprInstr (JSR reg addr n)
  = hcat [
	ptext (sLit "\tjsr\t"),
	pprReg reg,
	comma,
	pprAddr addr
    ]

pprInstr (FUNBEGIN clab)
  = hcat [
	if (externallyVisibleCLabel clab) then
	    hcat [ptext (sLit "\t.globl\t"), pp_lab, char '\n']
	else
	    empty,
	ptext (sLit "\t.ent "),
	pp_lab,
	char '\n',
	pp_lab,
	pp_ldgp,
	pp_lab,
	pp_frame
    ]
    where
	pp_lab = pprCLabel_asm clab

        -- NEVER use commas within those string literals, cpp will ruin your day
	pp_ldgp  = hcat [ ptext (sLit ":\n\tldgp $29"), char ',', ptext (sLit "0($27)\n") ]
	pp_frame = hcat [ ptext (sLit "..ng:\n\t.frame $30"), char ',',
                          ptext (sLit "4240"), char ',',
                          ptext (sLit "$26"), char ',',
                          ptext (sLit "0\n\t.prologue 1") ]

pprInstr (FUNEND clab)
  = (<>) (ptext (sLit "\t.align 4\n\t.end ")) (pprCLabel_asm clab)


pprRI :: RI -> Doc

pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r

pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
pprRegRIReg name reg1 ri reg2
  = hcat [
 	char '\t',
	ptext name,
	char '\t',
	pprReg reg1,
	comma,
	pprRI ri,
	comma,
	pprReg reg2
    ]

pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
  = hcat [
	char '\t',
	ptext name,
	pprSize size,
	char '\t',
	pprReg reg1,
	comma,
	pprReg reg2,
	comma,
	pprReg reg3
    ]

-}



