--------------------------------------------------------------------------------- Pretty-printing assembly language---- (c) The University of Glasgow 1993-2005-------------------------------------------------------------------------------{-# OPTIONS -fno-warn-tabs #-}-- The above warning supression flag is a temporary kludge.-- While working on this module you are encouraged to remove it and-- detab the module (please do the detabbing in a separate patch). See-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces-- for detailsmoduleSPARC.Ppr(pprNatCmmDecl,pprBasicBlock,pprSectionHeader,pprData,pprInstr,pprSize,pprImm,pprDataItem)where#include "HsVersions.h"#include "nativeGen/NCG.h"importSPARC.RegsimportSPARC.InstrimportSPARC.CondimportSPARC.ImmimportSPARC.AddrModeimportSPARC.BaseimportInstructionimportRegimportSizeimportPprBaseimportOldCmmimportOldPprCmm()importCLabelimportUnique(Uniquable(..),pprUnique)importOutputableimportPlatformimportFastStringimportData.Word-- ------------------------------------------------------------------------------- Printing this stuff outpprNatCmmDecl::Platform->NatCmmDeclCmmStaticsInstr->SDocpprNatCmmDeclplatform(CmmDatasectiondats)=pprSectionHeadersection$$pprDatasplatformdats-- special case for split markers:pprNatCmmDeclplatform(CmmProcNothinglbl(ListGraph[]))=pprLabelplatformlbl-- special case for code without info table:pprNatCmmDeclplatform(CmmProcNothinglbl(ListGraphblocks))=pprSectionHeaderText$$pprLabelplatformlbl$$-- blocks guaranteed not null, so label neededvcat(map(pprBasicBlockplatform)blocks)pprNatCmmDeclplatform(CmmProc(Just(Staticsinfo_lblinfo))_entry_lbl(ListGraphblocks))=pprSectionHeaderText$$((ifplatformHasSubsectionsViaSymbolsplatformthenpprCLabelplatform(mkDeadStripPreventerinfo_lbl)<>char':'elseempty)$$vcat(map(pprDataplatform)info)$$pprLabelplatforminfo_lbl)$$vcat(map(pprBasicBlockplatform)blocks)$$-- above: Even the first block gets a label, because with branch-chain-- elimination, it might be the target of a goto.(ifplatformHasSubsectionsViaSymbolsplatformthen-- 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).text"\t.long "<+>pprCLabelplatforminfo_lbl<+>char'-'<+>pprCLabelplatform(mkDeadStripPreventerinfo_lbl)elseempty)pprBasicBlock::Platform->NatBasicBlockInstr->SDocpprBasicBlockplatform(BasicBlockblockidinstrs)=pprLabelplatform(mkAsmTempLabel(getUniqueblockid))$$vcat(map(pprInstrplatform)instrs)pprDatas::Platform->CmmStatics->SDocpprDatasplatform(Staticslbldats)=vcat(pprLabelplatformlbl:map(pprDataplatform)dats)pprData::Platform->CmmStatic->SDocpprData_(CmmStringstr)=pprASCIIstrpprData_(CmmUninitialisedbytes)=ptext(sLit".skip ")<>intbytespprDataplatform(CmmStaticLitlit)=pprDataItemplatformlitpprGloblDecl::Platform->CLabel->SDocpprGloblDeclplatformlbl|not(externallyVisibleCLabellbl)=empty|otherwise=ptext(sLit".global ")<>pprCLabelplatformlblpprTypeAndSizeDecl::Platform->CLabel->SDocpprTypeAndSizeDeclplatformlbl|platformOSplatform==OSLinux&&externallyVisibleCLabellbl=ptext(sLit".type ")<>pprCLabelplatformlbl<>ptext(sLit", @object")|otherwise=emptypprLabel::Platform->CLabel->SDocpprLabelplatformlbl=pprGloblDeclplatformlbl$$pprTypeAndSizeDeclplatformlbl$$(pprCLabelplatformlbl<>char':')pprASCII::[Word8]->SDocpprASCIIstr=vcat(mapdo1str)$$do10wheredo1::Word8->SDocdo1w=ptext(sLit"\t.byte\t")<>int(fromIntegralw)-- ------------------------------------------------------------------------------- pprInstr: print an 'Instr'instanceOutputableInstrwherepprinstr=sdocWithPlatform$\platform->pprInstrplatforminstr-- | Pretty print a register.pprReg::Reg->SDocpprRegreg=caseregofRegVirtualvr->casevrofVirtualRegIu->text"%vI_"<>pprUniqueuVirtualRegHiu->text"%vHi_"<>pprUniqueuVirtualRegFu->text"%vF_"<>pprUniqueuVirtualRegDu->text"%vD_"<>pprUniqueuVirtualRegSSEu->text"%vSSE_"<>pprUniqueuRegRealrr->caserrofRealRegSingler1->pprReg_ofRegNor1RealRegPairr1r2->text"("<>pprReg_ofRegNor1<>text"|"<>pprReg_ofRegNor2<>text")"-- | Pretty print a register name, based on this register number.-- The definition has been unfolded so we get a jump-table in the-- object code. This function is called quite a lot when emitting the asm file..--pprReg_ofRegNo::Int->SDocpprReg_ofRegNoi=ptext(caseiof{0->sLit"%g0";1->sLit"%g1";2->sLit"%g2";3->sLit"%g3";4->sLit"%g4";5->sLit"%g5";6->sLit"%g6";7->sLit"%g7";8->sLit"%o0";9->sLit"%o1";10->sLit"%o2";11->sLit"%o3";12->sLit"%o4";13->sLit"%o5";14->sLit"%o6";15->sLit"%o7";16->sLit"%l0";17->sLit"%l1";18->sLit"%l2";19->sLit"%l3";20->sLit"%l4";21->sLit"%l5";22->sLit"%l6";23->sLit"%l7";24->sLit"%i0";25->sLit"%i1";26->sLit"%i2";27->sLit"%i3";28->sLit"%i4";29->sLit"%i5";30->sLit"%i6";31->sLit"%i7";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 sparc register"})-- | Pretty print a size for an instruction suffix.pprSize::Size->SDocpprSizex=ptext(casexofII8->sLit"ub"II16->sLit"uh"II32->sLit""II64->sLit"d"FF32->sLit""FF64->sLit"d"_->panic"SPARC.Ppr.pprSize: no match")-- | Pretty print a size for an instruction suffix.-- eg LD is 32bit on sparc, but LDD is 64 bit.pprStSize::Size->SDocpprStSizex=ptext(casexofII8->sLit"b"II16->sLit"h"II32->sLit""II64->sLit"x"FF32->sLit""FF64->sLit"d"_->panic"SPARC.Ppr.pprSize: no match")-- | Pretty print a condition code.pprCond::Cond->SDocpprCondc=ptext(casecofALWAYS->sLit""NEVER->sLit"n"GEU->sLit"geu"LU->sLit"lu"EQQ->sLit"e"GTT->sLit"g"GE->sLit"ge"GU->sLit"gu"LTT->sLit"l"LE->sLit"le"LEU->sLit"leu"NE->sLit"ne"NEG->sLit"neg"POS->sLit"pos"VC->sLit"vc"VS->sLit"vs")-- | Pretty print an address mode.pprAddr::Platform->AddrMode->SDocpprAddrplatformam=caseamofAddrRegRegr1(RegReal(RealRegSingle0))->pprRegr1AddrRegRegr1r2->hcat[pprRegr1,char'+',pprRegr2]AddrRegImmr1(ImmInti)|i==0->pprRegr1|not(fits13Bitsi)->largeOffsetErrori|otherwise->hcat[pprRegr1,pp_sign,inti]wherepp_sign=ifi>0thenchar'+'elseemptyAddrRegImmr1(ImmIntegeri)|i==0->pprRegr1|not(fits13Bitsi)->largeOffsetErrori|otherwise->hcat[pprRegr1,pp_sign,integeri]wherepp_sign=ifi>0thenchar'+'elseemptyAddrRegImmr1imm->hcat[pprRegr1,char'+',pprImmplatformimm]-- | Pretty print an immediate value.pprImm::Platform->Imm->SDocpprImmplatformimm=caseimmofImmInti->intiImmIntegeri->integeriImmCLbll->pprCLabelplatformlImmIndexli->pprCLabelplatforml<>char'+'<>intiImmLits->sImmConstantSumab->pprImmplatforma<>char'+'<>pprImmplatformbImmConstantDiffab->pprImmplatforma<>char'-'<>lparen<>pprImmplatformb<>rparenLOi->hcat[text"%lo(",pprImmplatformi,rparen]HIi->hcat[text"%hi(",pprImmplatformi,rparen]-- these should have been converted to bytes and placed-- in the data section.ImmFloat_->ptext(sLit"naughty float immediate")ImmDouble_->ptext(sLit"naughty double immediate")-- | Pretty print a section \/ segment header.-- On SPARC all the data sections must be at least 8 byte aligned-- incase we store doubles in them.--pprSectionHeader::Section->SDocpprSectionHeaderseg=casesegofText->ptext(sLit".text\n\t.align 4")Data->ptext(sLit".data\n\t.align 8")ReadOnlyData->ptext(sLit".text\n\t.align 8")RelocatableReadOnlyData->ptext(sLit".text\n\t.align 8")UninitialisedData->ptext(sLit".bss\n\t.align 8")ReadOnlyData16->ptext(sLit".data\n\t.align 16")OtherSection_->panic"PprMach.pprSectionHeader: unknown section"-- | Pretty print a data item.pprDataItem::Platform->CmmLit->SDocpprDataItemplatformlit=vcat(ppr_item(cmmTypeSize$cmmLitTypelit)lit)whereimm=litToImmlitppr_itemII8_=[ptext(sLit"\t.byte\t")<>pprImmplatformimm]ppr_itemII32_=[ptext(sLit"\t.long\t")<>pprImmplatformimm]ppr_itemFF32(CmmFloatr_)=letbs=floatToBytes(fromRationalr)inmap(\b->ptext(sLit"\t.byte\t")<>pprImmplatform(ImmIntb))bsppr_itemFF64(CmmFloatr_)=letbs=doubleToBytes(fromRationalr)inmap(\b->ptext(sLit"\t.byte\t")<>pprImmplatform(ImmIntb))bsppr_itemII16_=[ptext(sLit"\t.short\t")<>pprImmplatformimm]ppr_itemII64_=[ptext(sLit"\t.quad\t")<>pprImmplatformimm]ppr_item__=panic"SPARC.Ppr.pprDataItem: no match"-- | Pretty print an instruction.pprInstr::Platform->Instr->SDoc-- nuke comments.pprInstr_(COMMENT_)=emptypprInstrplatform(DELTAd)=pprInstrplatform(COMMENT(mkFastString("\tdelta = "++showd)))-- Newblocks and LData should have been slurped out before producing the .s file.pprInstr_(NEWBLOCK_)=panic"X86.Ppr.pprInstr: NEWBLOCK"pprInstr_(LDATA__)=panic"PprMach.pprInstr: LDATA"-- 64 bit FP loads are expanded into individual instructions in CodeGen.ExpandpprInstr_(LDFF64_reg)|RegReal(RealRegSingle{})<-reg=panic"SPARC.Ppr: not emitting potentially misaligned LD FF64 instr"pprInstrplatform(LDsizeaddrreg)=hcat[ptext(sLit"\tld"),pprSizesize,char'\t',lbrack,pprAddrplatformaddr,pp_rbracket_comma,pprRegreg]-- 64 bit FP storees are expanded into individual instructions in CodeGen.ExpandpprInstr_(STFF64reg_)|RegReal(RealRegSingle{})<-reg=panic"SPARC.Ppr: not emitting potentially misaligned ST FF64 instr"-- no distinction is made between signed and unsigned bytes on stores for the-- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),-- so we call a special-purpose pprSize for ST..pprInstrplatform(STsizeregaddr)=hcat[ptext(sLit"\tst"),pprStSizesize,char'\t',pprRegreg,pp_comma_lbracket,pprAddrplatformaddr,rbrack]pprInstrplatform(ADDxccreg1rireg2)|notx&&notcc&&riZerori=hcat[ptext(sLit"\tmov\t"),pprRegreg1,comma,pprRegreg2]|otherwise=pprRegRIRegplatform(ifxthensLit"addx"elsesLit"add")ccreg1rireg2pprInstrplatform(SUBxccreg1rireg2)|notx&&cc&&reg2==g0=hcat[ptext(sLit"\tcmp\t"),pprRegreg1,comma,pprRIplatformri]|notx&&notcc&&riZerori=hcat[ptext(sLit"\tmov\t"),pprRegreg1,comma,pprRegreg2]|otherwise=pprRegRIRegplatform(ifxthensLit"subx"elsesLit"sub")ccreg1rireg2pprInstrplatform(ANDbreg1rireg2)=pprRegRIRegplatform(sLit"and")breg1rireg2pprInstrplatform(ANDNbreg1rireg2)=pprRegRIRegplatform(sLit"andn")breg1rireg2pprInstrplatform(ORbreg1rireg2)|notb&&reg1==g0=letdoit=hcat[ptext(sLit"\tmov\t"),pprRIplatformri,comma,pprRegreg2]incaseriofRIRegrrr|rrr==reg2->empty_->doit|otherwise=pprRegRIRegplatform(sLit"or")breg1rireg2pprInstrplatform(ORNbreg1rireg2)=pprRegRIRegplatform(sLit"orn")breg1rireg2pprInstrplatform(XORbreg1rireg2)=pprRegRIRegplatform(sLit"xor")breg1rireg2pprInstrplatform(XNORbreg1rireg2)=pprRegRIRegplatform(sLit"xnor")breg1rireg2pprInstrplatform(SLLreg1rireg2)=pprRegRIRegplatform(sLit"sll")Falsereg1rireg2pprInstrplatform(SRLreg1rireg2)=pprRegRIRegplatform(sLit"srl")Falsereg1rireg2pprInstrplatform(SRAreg1rireg2)=pprRegRIRegplatform(sLit"sra")Falsereg1rireg2pprInstr_(RDYrd)=ptext(sLit"\trd\t%y,")<>pprRegrdpprInstr_(WRYreg1reg2)=ptext(sLit"\twr\t")<>pprRegreg1<>char','<>pprRegreg2<>char','<>ptext(sLit"%y")pprInstrplatform(SMULbreg1rireg2)=pprRegRIRegplatform(sLit"smul")breg1rireg2pprInstrplatform(UMULbreg1rireg2)=pprRegRIRegplatform(sLit"umul")breg1rireg2pprInstrplatform(SDIVbreg1rireg2)=pprRegRIRegplatform(sLit"sdiv")breg1rireg2pprInstrplatform(UDIVbreg1rireg2)=pprRegRIRegplatform(sLit"udiv")breg1rireg2pprInstrplatform(SETHIimmreg)=hcat[ptext(sLit"\tsethi\t"),pprImmplatformimm,comma,pprRegreg]pprInstr_NOP=ptext(sLit"\tnop")pprInstr_(FABSsizereg1reg2)=pprSizeRegReg(sLit"fabs")sizereg1reg2pprInstr_(FADDsizereg1reg2reg3)=pprSizeRegRegReg(sLit"fadd")sizereg1reg2reg3pprInstr_(FCMPesizereg1reg2)=pprSizeRegReg(ifethensLit"fcmpe"elsesLit"fcmp")sizereg1reg2pprInstr_(FDIVsizereg1reg2reg3)=pprSizeRegRegReg(sLit"fdiv")sizereg1reg2reg3pprInstr_(FMOVsizereg1reg2)=pprSizeRegReg(sLit"fmov")sizereg1reg2pprInstr_(FMULsizereg1reg2reg3)=pprSizeRegRegReg(sLit"fmul")sizereg1reg2reg3pprInstr_(FNEGsizereg1reg2)=pprSizeRegReg(sLit"fneg")sizereg1reg2pprInstr_(FSQRTsizereg1reg2)=pprSizeRegReg(sLit"fsqrt")sizereg1reg2pprInstr_(FSUBsizereg1reg2reg3)=pprSizeRegRegReg(sLit"fsub")sizereg1reg2reg3pprInstr_(FxTOysize1size2reg1reg2)=hcat[ptext(sLit"\tf"),ptext(casesize1ofII32->sLit"ito"FF32->sLit"sto"FF64->sLit"dto"_->panic"SPARC.Ppr.pprInstr.FxToY: no match"),ptext(casesize2ofII32->sLit"i\t"II64->sLit"x\t"FF32->sLit"s\t"FF64->sLit"d\t"_->panic"SPARC.Ppr.pprInstr.FxToY: no match"),pprRegreg1,comma,pprRegreg2]pprInstrplatform(BIcondbblockid)=hcat[ptext(sLit"\tb"),pprCondcond,ifbthenpp_comma_aelseempty,char'\t',pprCLabelplatform(mkAsmTempLabel(getUniqueblockid))]pprInstrplatform(BFcondbblockid)=hcat[ptext(sLit"\tfb"),pprCondcond,ifbthenpp_comma_aelseempty,char'\t',pprCLabelplatform(mkAsmTempLabel(getUniqueblockid))]pprInstrplatform(JMPaddr)=(<>)(ptext(sLit"\tjmp\t"))(pprAddrplatformaddr)pprInstrplatform(JMP_TBLop__)=pprInstrplatform(JMPop)pprInstrplatform(CALL(Leftimm)n_)=hcat[ptext(sLit"\tcall\t"),pprImmplatformimm,comma,intn]pprInstr_(CALL(Rightreg)n_)=hcat[ptext(sLit"\tcall\t"),pprRegreg,comma,intn]-- | Pretty print a RIpprRI::Platform->RI->SDocpprRI_(RIRegr)=pprRegrpprRIplatform(RIImmr)=pprImmplatformr-- | Pretty print a two reg instruction.pprSizeRegReg::LitString->Size->Reg->Reg->SDocpprSizeRegRegnamesizereg1reg2=hcat[char'\t',ptextname,(casesizeofFF32->ptext(sLit"s\t")FF64->ptext(sLit"d\t")_->panic"SPARC.Ppr.pprSizeRegReg: no match"),pprRegreg1,comma,pprRegreg2]-- | Pretty print a three reg instruction.pprSizeRegRegReg::LitString->Size->Reg->Reg->Reg->SDocpprSizeRegRegRegnamesizereg1reg2reg3=hcat[char'\t',ptextname,(casesizeofFF32->ptext(sLit"s\t")FF64->ptext(sLit"d\t")_->panic"SPARC.Ppr.pprSizeRegReg: no match"),pprRegreg1,comma,pprRegreg2,comma,pprRegreg3]-- | Pretty print an instruction of two regs and a ri.pprRegRIReg::Platform->LitString->Bool->Reg->RI->Reg->SDocpprRegRIRegplatformnamebreg1rireg2=hcat[char'\t',ptextname,ifbthenptext(sLit"cc\t")elsechar'\t',pprRegreg1,comma,pprRIplatformri,comma,pprRegreg2]{-
pprRIReg :: LitString -> Bool -> RI -> Reg -> SDoc
pprRIReg name b ri reg1
= hcat [
char '\t',
ptext name,
if b then ptext (sLit "cc\t") else char '\t',
pprRI ri,
comma,
pprReg reg1
]
-}{-
pp_ld_lbracket :: SDoc
pp_ld_lbracket = ptext (sLit "\tld\t[")
-}pp_rbracket_comma::SDocpp_rbracket_comma=text"],"pp_comma_lbracket::SDocpp_comma_lbracket=text",["pp_comma_a::SDocpp_comma_a=text",a"