X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2FnativeGen%2FPprMach.hs;h=1f94e5fd73ca98583fbd03b406f77b3373c4e002;hb=7fc749a43b4b6b85d234fa95d4928648259584f4;hp=29cd23effe7ff0c051d9ce27421bd2f66437f935;hpb=8cce5c2e09f2a1b7b443cdef0ede5593cc6e7f60;p=ghc-hetmet.git diff --git a/compiler/nativeGen/PprMach.hs b/compiler/nativeGen/PprMach.hs index 29cd23e..1f94e5f 100644 --- a/compiler/nativeGen/PprMach.hs +++ b/compiler/nativeGen/PprMach.hs @@ -10,11 +10,18 @@ -- (e.g., 'pprReg'); we conclude with the no-commonality monster, -- 'pprInstr'. +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + #include "nativeGen/NCG.h" module PprMach ( - pprNatCmmTop, pprBasicBlock, - pprInstr, pprSize, pprUserReg, + pprNatCmmTop, pprBasicBlock, pprSectionHeader, pprData, + pprInstr, pprSize, pprUserReg ) where @@ -36,6 +43,7 @@ import Unique ( pprUnique ) import Pretty import FastString import qualified Outputable +import Outputable ( Outputable ) import Data.Array.ST import Data.Word ( Word8 ) @@ -692,8 +700,18 @@ pprGloblDecl lbl SLIT(".globl ")) <> pprCLabel_asm lbl +pprTypeAndSizeDecl :: CLabel -> Doc +pprTypeAndSizeDecl lbl +#if linux_TARGET_OS + | not (externallyVisibleCLabel lbl) = empty + | otherwise = ptext SLIT(".type ") <> + pprCLabel_asm lbl <> ptext SLIT(", @object") +#else + = empty +#endif + pprLabel :: CLabel -> Doc -pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':') +pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':') pprASCII str @@ -788,6 +806,9 @@ pprDataItem lit -- ----------------------------------------------------------------------------- -- pprInstr: print an 'Instr' +instance Outputable Instr where + ppr instr = Outputable.docToSDoc $ pprInstr instr + pprInstr :: Instr -> Doc --pprInstr (COMMENT s) = empty -- nuke 'em @@ -815,6 +836,22 @@ pprInstr (LDATA _ _) #if alpha_TARGET_ARCH +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"), @@ -1197,14 +1234,21 @@ pprSizeRegRegReg name size reg1 reg2 reg3 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH -pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack - | src == dst - = -#if 0 /* #ifdef DEBUG */ - (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d) -#else - empty -#endif +pprInstr (SPILL reg slot) + = hcat [ + ptext SLIT("\tSPILL"), + char ' ', + pprUserReg reg, + comma, + ptext SLIT("SLOT") <> parens (int slot)] + +pprInstr (RELOAD slot reg) + = hcat [ + ptext SLIT("\tRELOAD"), + char ' ', + ptext SLIT("SLOT") <> parens (int slot), + comma, + pprUserReg reg] pprInstr (MOV size src dst) = pprSizeOpOp SLIT("mov") size src dst @@ -1767,6 +1811,22 @@ pprCondInstr name cond arg -- reads (bytearrays). -- +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] + -- Translate to the following: -- add g1,g2,g1 -- ld [g1],%fn @@ -2041,6 +2101,23 @@ pp_comma_a = text ",a" -- pprInstr for PowerPC #if powerpc_TARGET_ARCH + +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"),