X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FSPARC%2FPpr.hs;h=d78d1a760e3090f7cac12e0eb2a7262916a1128e;hp=d517a0808578144bc19f736fbd3fdd743625eec7;hb=7867349134ee26e4276ff04ace7c815c1de43338;hpb=f9288086f935c97812b2d80defcff38baf7b6a6c diff --git a/compiler/nativeGen/SPARC/Ppr.hs b/compiler/nativeGen/SPARC/Ppr.hs index d517a08..d78d1a7 100644 --- a/compiler/nativeGen/SPARC/Ppr.hs +++ b/compiler/nativeGen/SPARC/Ppr.hs @@ -12,7 +12,6 @@ module SPARC.Ppr ( pprSectionHeader, pprData, pprInstr, - pprUserReg, pprSize, pprImm, pprDataItem @@ -34,11 +33,11 @@ import Reg import Size import PprBase -import BlockId -import Cmm +import OldCmm +import OldPprCmm() import CLabel -import Unique ( pprUnique ) +import Unique ( Uniquable(..), pprUnique ) import qualified Outputable import Outputable (Outputable, panic) import Pretty @@ -53,9 +52,9 @@ pprNatCmmTop (CmmData section dats) = pprSectionHeader section $$ vcat (map pprData dats) -- special case for split markers: -pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl +pprNatCmmTop (CmmProc [] lbl (ListGraph [])) = pprLabel lbl -pprNatCmmTop (CmmProc info lbl _ (ListGraph blocks)) = +pprNatCmmTop (CmmProc info lbl (ListGraph blocks)) = pprSectionHeader Text $$ (if null info then -- blocks guaranteed not null, so label needed pprLabel lbl @@ -87,8 +86,8 @@ pprNatCmmTop (CmmProc info lbl _ (ListGraph blocks)) = pprBasicBlock :: NatBasicBlock Instr -> Doc -pprBasicBlock (BasicBlock (BlockId id) instrs) = - pprLabel (mkAsmTempLabel id) $$ +pprBasicBlock (BasicBlock blockid instrs) = + pprLabel (mkAsmTempLabel (getUnique blockid)) $$ vcat (map pprInstr instrs) @@ -102,9 +101,7 @@ 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 + | otherwise = ptext (sLit ".global ") <> pprCLabel_asm lbl pprTypeAndSizeDecl :: CLabel -> Doc #if linux_TARGET_OS @@ -141,12 +138,6 @@ instance Outputable Instr where -- | Pretty print a register. --- This is an alias of pprReg for legacy reasons, should remove it. -pprUserReg :: Reg -> Doc -pprUserReg = pprReg - - --- | Pretty print a register. pprReg :: Reg -> Doc pprReg reg = case reg of @@ -156,6 +147,7 @@ pprReg reg VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u) VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u) VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u) + VirtualRegSSE u -> text "%vSSE_" <> asmSDoc (pprUnique u) RegReal rr -> case rr of @@ -525,24 +517,24 @@ pprInstr (FxTOy size1 size2 reg1 reg2) ] -pprInstr (BI cond b (BlockId id)) +pprInstr (BI cond b blockid) = hcat [ ptext (sLit "\tb"), pprCond cond, if b then pp_comma_a else empty, char '\t', - pprCLabel_asm (mkAsmTempLabel id) + pprCLabel_asm (mkAsmTempLabel (getUnique blockid)) ] -pprInstr (BF cond b (BlockId id)) +pprInstr (BF cond b blockid) = hcat [ ptext (sLit "\tfb"), pprCond cond, if b then pp_comma_a else empty, char '\t', - pprCLabel_asm (mkAsmTempLabel id) + pprCLabel_asm (mkAsmTempLabel (getUnique blockid)) ] pprInstr (JMP addr) = (<>) (ptext (sLit "\tjmp\t")) (pprAddr addr) -pprInstr (JMP_TBL op _) = pprInstr (JMP op) +pprInstr (JMP_TBL op _ _) = pprInstr (JMP op) pprInstr (CALL (Left imm) n _) = hcat [ ptext (sLit "\tcall\t"), pprImm imm, comma, int n ]