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 ] -}