X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.lhs;h=700700e2f5c06c03ee084fac652d1204433e23f2;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=9b2cd26b7cb8a5e80695be0517683f67c4715606;hpb=baaa28b37a9c945e648feb300fdc2c29904919c2;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 9b2cd26..700700e 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -1,5 +1,5 @@ % -% (c) The AQUA Project, Glasgow University, 1996 +% (c) The AQUA Project, Glasgow University, 1996-1998 % \section[PprMach]{Pretty-printing assembly language} @@ -8,33 +8,21 @@ We start with the @pprXXX@s with some cross-platform commonality @pprInstr@. \begin{code} -#include "HsVersions.h" #include "nativeGen/NCG.h" module PprMach ( pprInstr ) where -IMP_Ubiq(){-uitious-} -IMPORT_1_3(Char(isPrint,isDigit)) -IMPORT_1_3(qualified GHCbase(Addr(..))) -- to see innards +#include "HsVersions.h" import MachRegs -- may differ per-platform import MachMisc -import AbsCSyn ( MagicId ) import CLabel ( pprCLabel_asm, externallyVisibleCLabel ) import CStrings ( charToC ) import Maybes ( maybeToBool ) -import OrdList ( OrdList ) -import Stix ( CodeSegment(..), StixTree ) -import Unpretty -- all of it - -#if __GLASGOW_HASKELL__ >= 200 -a_HASH x = GHCbase.A# x -pACK_STR x = packCString x -#else -a_HASH x = A# x -pACK_STR x = mkFastCharString x --_packCString x -#endif +import Stix ( CodeSegment(..) ) +import Char ( isPrint, isDigit ) +import Outputable \end{code} %************************************************************************ @@ -46,17 +34,17 @@ pACK_STR x = mkFastCharString x --_packCString x For x86, the way we print a register name depends on which bit of it we care about. Yurgh. \begin{code} -pprReg :: IF_ARCH_i386(Size ->,) Reg -> Unpretty +pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc pprReg IF_ARCH_i386(s,) r = case r of FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i - other -> uppStr (show other) -- should only happen when debugging + other -> text (show other) -- should only happen when debugging where #if alpha_TARGET_ARCH - ppr_reg_no :: FAST_REG_NO -> Unpretty - ppr_reg_no i = uppPStr + ppr_reg_no :: FAST_REG_NO -> SDoc + ppr_reg_no i = ptext (case i of { ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1"); ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3"); @@ -94,8 +82,8 @@ pprReg IF_ARCH_i386(s,) r }) #endif #if i386_TARGET_ARCH - ppr_reg_no :: Size -> FAST_REG_NO -> Unpretty - ppr_reg_no B i = uppPStr + ppr_reg_no :: Size -> FAST_REG_NO -> SDoc + ppr_reg_no B i = ptext (case i of { ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl"); ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl"); @@ -103,7 +91,7 @@ pprReg IF_ARCH_i386(s,) r }) {- UNUSED: - ppr_reg_no HB i = uppPStr + ppr_reg_no HB i = ptext (case i of { ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh"); ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh"); @@ -112,7 +100,7 @@ pprReg IF_ARCH_i386(s,) r -} {- UNUSED: - ppr_reg_no S i = uppPStr + ppr_reg_no S i = ptext (case i of { ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx"); ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx"); @@ -122,7 +110,7 @@ pprReg IF_ARCH_i386(s,) r }) -} - ppr_reg_no L i = uppPStr + ppr_reg_no L i = ptext (case i of { ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx"); ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx"); @@ -131,7 +119,7 @@ pprReg IF_ARCH_i386(s,) r _ -> SLIT("very naughty I386 double word register") }) - ppr_reg_no F i = uppPStr + ppr_reg_no F i = ptext (case i of { --ToDo: rm these (???) ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)"); @@ -141,7 +129,7 @@ pprReg IF_ARCH_i386(s,) r _ -> SLIT("very naughty I386 float register") }) - ppr_reg_no DF i = uppPStr + ppr_reg_no DF i = ptext (case i of { --ToDo: rm these (???) ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)"); @@ -152,8 +140,8 @@ pprReg IF_ARCH_i386(s,) r }) #endif #if sparc_TARGET_ARCH - ppr_reg_no :: FAST_REG_NO -> Unpretty - ppr_reg_no i = uppPStr + ppr_reg_no :: FAST_REG_NO -> SDoc + ppr_reg_no i = ptext (case i of { ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1"); ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3"); @@ -199,9 +187,9 @@ pprReg IF_ARCH_i386(s,) r %************************************************************************ \begin{code} -pprSize :: Size -> Unpretty +pprSize :: Size -> SDoc -pprSize x = uppPStr (case x of +pprSize x = ptext (case x of #if alpha_TARGET_ARCH B -> SLIT("b") BU -> SLIT("bu") @@ -232,6 +220,17 @@ pprSize x = uppPStr (case x of F -> SLIT("") -- D -> SLIT("d") UNUSED DF -> SLIT("d") + ) +pprStSize :: Size -> SDoc +pprStSize x = ptext (case x of + B -> SLIT("b") + BU -> SLIT("b") +-- HW -> SLIT("hw") UNUSED +-- HWU -> SLIT("uhw") UNUSED + W -> SLIT("") + F -> SLIT("") +-- D -> SLIT("d") UNUSED + DF -> SLIT("d") #endif ) \end{code} @@ -243,9 +242,9 @@ pprSize x = uppPStr (case x of %************************************************************************ \begin{code} -pprCond :: Cond -> Unpretty +pprCond :: Cond -> SDoc -pprCond c = uppPStr (case c of { +pprCond c = ptext (case c of { #if alpha_TARGET_ARCH EQQ -> SLIT("eq"); LTT -> SLIT("lt"); @@ -285,26 +284,27 @@ pprCond c = uppPStr (case c of { %************************************************************************ \begin{code} -pprImm :: Imm -> Unpretty +pprImm :: Imm -> SDoc -pprImm (ImmInt i) = uppInt i -pprImm (ImmInteger i) = uppInteger i +pprImm (ImmInt i) = int i +pprImm (ImmInteger i) = integer i pprImm (ImmCLbl l) = pprCLabel_asm l +pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i pprImm (ImmLit s) = s -pprImm (ImmLab s) | underscorePrefix = uppBeside (uppChar '_') s +pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s | otherwise = s #if sparc_TARGET_ARCH pprImm (LO i) - = uppBesides [ pp_lo, pprImm i, uppRparen ] + = hcat [ pp_lo, pprImm i, rparen ] where - pp_lo = uppPStr (pACK_STR (a_HASH "%lo("#)) + pp_lo = text "%lo(" pprImm (HI i) - = uppBesides [ pp_hi, pprImm i, uppRparen ] + = hcat [ pp_hi, pprImm i, rparen ] where - pp_hi = uppPStr (pACK_STR (a_HASH "%hi("#)) + pp_hi = text "%hi(" #endif \end{code} @@ -315,13 +315,13 @@ pprImm (HI i) %************************************************************************ \begin{code} -pprAddr :: Addr -> Unpretty +pprAddr :: MachRegsAddr -> SDoc #if alpha_TARGET_ARCH -pprAddr (AddrReg r) = uppParens (pprReg r) +pprAddr (AddrReg r) = parens (pprReg r) pprAddr (AddrImm i) = pprImm i pprAddr (AddrRegImm r1 i) - = uppBeside (pprImm i) (uppParens (pprReg r1)) + = (<>) (pprImm i) (parens (pprReg r1)) #endif ------------------- @@ -334,23 +334,23 @@ pprAddr (ImmAddr imm off) if (off == 0) then pp_imm else if (off < 0) then - uppBeside pp_imm (uppInt off) + (<>) pp_imm (int off) else - uppBesides [pp_imm, uppChar '+', uppInt off] + hcat [pp_imm, char '+', int off] -pprAddr (Addr base index displacement) +pprAddr (AddrBaseIndex base index displacement) = let pp_disp = ppr_disp displacement - pp_off p = uppBeside pp_disp (uppParens p) + pp_off p = (<>) pp_disp (parens p) pp_reg r = pprReg L r in case (base,index) of (Nothing, Nothing) -> pp_disp (Just b, Nothing) -> pp_off (pp_reg b) - (Nothing, Just (r,i)) -> pp_off (uppBesides [pp_reg r, uppComma, uppInt i]) - (Just b, Just (r,i)) -> pp_off (uppBesides [pp_reg b, uppComma, pp_reg r, uppComma, uppInt i]) + (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i]) + (Just b, Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i]) where - ppr_disp (ImmInt 0) = uppNil + ppr_disp (ImmInt 0) = empty ppr_disp imm = pprImm imm #endif @@ -360,24 +360,24 @@ pprAddr (Addr base index displacement) pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1 pprAddr (AddrRegReg r1 r2) - = uppBesides [ pprReg r1, uppChar '+', pprReg r2 ] + = hcat [ pprReg r1, char '+', pprReg r2 ] pprAddr (AddrRegImm r1 (ImmInt i)) | i == 0 = pprReg r1 | not (fits13Bits i) = largeOffsetError i - | otherwise = uppBesides [ pprReg r1, pp_sign, uppInt i ] + | otherwise = hcat [ pprReg r1, pp_sign, int i ] where - pp_sign = if i > 0 then uppChar '+' else uppNil + pp_sign = if i > 0 then char '+' else empty pprAddr (AddrRegImm r1 (ImmInteger i)) | i == 0 = pprReg r1 | not (fits13Bits i) = largeOffsetError i - | otherwise = uppBesides [ pprReg r1, pp_sign, uppInteger i ] + | otherwise = hcat [ pprReg r1, pp_sign, integer i ] where - pp_sign = if i > 0 then uppChar '+' else uppNil + pp_sign = if i > 0 then char '+' else empty pprAddr (AddrRegImm r1 imm) - = uppBesides [ pprReg r1, uppChar '+', pprImm imm ] + = hcat [ pprReg r1, char '+', pprImm imm ] #endif \end{code} @@ -388,22 +388,23 @@ pprAddr (AddrRegImm r1 imm) %************************************************************************ \begin{code} -pprInstr :: Instr -> Unpretty +pprInstr :: Instr -> SDoc -pprInstr (COMMENT s) = uppNil -- nuke 'em ---alpha: = uppBeside (uppPStr SLIT("\t# ")) (uppPStr s) ---i386 : = uppBeside (uppPStr SLIT("# ")) (uppPStr s) ---sparc: = uppBeside (uppPStr SLIT("! ")) (uppPStr s) +--pprInstr (COMMENT s) = (<>) (ptext SLIT("# ")) (ptext s) +pprInstr (COMMENT s) = empty -- nuke 'em +--alpha: = (<>) (ptext SLIT("\t# ")) (ptext s) +--i386 : = (<>) (ptext SLIT("# ")) (ptext s) +--sparc: = (<>) (ptext SLIT("! ")) (ptext s) pprInstr (SEGMENT TextSegment) - = uppPStr + = ptext IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-} ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-} ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-} ,))) pprInstr (SEGMENT DataSegment) - = uppPStr + = ptext IF_ARCH_alpha(SLIT("\t.data\n\t.align 3") ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -} ,IF_ARCH_i386(SLIT(".data\n\t.align 2") @@ -413,41 +414,40 @@ pprInstr (LABEL clab) = let pp_lab = pprCLabel_asm clab in - uppBesides [ + hcat [ if not (externallyVisibleCLabel clab) then - uppNil + empty else - uppBesides [uppPStr + hcat [ptext IF_ARCH_alpha(SLIT("\t.globl\t") ,IF_ARCH_i386(SLIT(".globl ") ,IF_ARCH_sparc(SLIT("\t.global\t") ,))) - , pp_lab, uppChar '\n'], + , pp_lab, char '\n'], pp_lab, - uppChar ':' + char ':' ] pprInstr (ASCII False{-no backslash conversion-} str) - = uppBesides [ uppPStr SLIT("\t.asciz "), uppChar '\"', uppStr str, uppChar '"' ] + = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ] pprInstr (ASCII True str) - = uppBeside (uppStr "\t.ascii \"") (asciify str 60) + = (<>) (text "\t.ascii \"") (asciify str 60) where - asciify :: String -> Int -> Unpretty - - asciify [] _ = uppStr "\\0\"" - asciify s n | n <= 0 = uppBeside (uppStr "\"\n\t.ascii \"") (asciify s 60) - asciify ('\\':cs) n = uppBeside (uppStr "\\\\") (asciify cs (n-1)) - asciify ('\"':cs) n = uppBeside (uppStr "\\\"") (asciify cs (n-1)) - asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1)) - asciify [c] _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\"")) + asciify :: String -> Int -> SDoc + + asciify [] _ = text "\\0\"" + asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60) + asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1)) + asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1)) + asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1)) + asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-} asciify (c:(cs@(d:_))) n - | isDigit d = uppBeside (uppStr (charToC c)) (asciify cs 0) - | otherwise = uppBeside (uppStr (charToC c)) (asciify cs (n-1)) + | isDigit d = (<>) (text (charToC c)) (asciify cs 0) + | otherwise = (<>) (text (charToC c)) (asciify cs (n-1)) pprInstr (DATA s xs) - = uppInterleave (uppChar '\n') - [uppBeside (uppPStr pp_size) (pprImm x) | x <- xs] + = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs] where pp_size = case s of #if alpha_TARGET_ARCH @@ -468,7 +468,7 @@ pprInstr (DATA s xs) --UNUSED: HB -> SLIT("\t.byte\t") --UNUSED: S -> SLIT("\t.word\t") L -> SLIT("\t.long\t") - F -> SLIT("\t.long\t") + F -> SLIT("\t.float\t") DF -> SLIT("\t.double\t") #endif #if sparc_TARGET_ARCH @@ -491,177 +491,177 @@ pprInstr (DATA s xs) #if alpha_TARGET_ARCH pprInstr (LD size reg addr) - = uppBesides [ - uppPStr SLIT("\tld"), + = hcat [ + ptext SLIT("\tld"), pprSize size, - uppChar '\t', + char '\t', pprReg reg, - uppComma, + comma, pprAddr addr ] pprInstr (LDA reg addr) - = uppBesides [ - uppPStr SLIT("\tlda\t"), + = hcat [ + ptext SLIT("\tlda\t"), pprReg reg, - uppComma, + comma, pprAddr addr ] pprInstr (LDAH reg addr) - = uppBesides [ - uppPStr SLIT("\tldah\t"), + = hcat [ + ptext SLIT("\tldah\t"), pprReg reg, - uppComma, + comma, pprAddr addr ] pprInstr (LDGP reg addr) - = uppBesides [ - uppPStr SLIT("\tldgp\t"), + = hcat [ + ptext SLIT("\tldgp\t"), pprReg reg, - uppComma, + comma, pprAddr addr ] pprInstr (LDI size reg imm) - = uppBesides [ - uppPStr SLIT("\tldi"), + = hcat [ + ptext SLIT("\tldi"), pprSize size, - uppChar '\t', + char '\t', pprReg reg, - uppComma, + comma, pprImm imm ] pprInstr (ST size reg addr) - = uppBesides [ - uppPStr SLIT("\tst"), + = hcat [ + ptext SLIT("\tst"), pprSize size, - uppChar '\t', + char '\t', pprReg reg, - uppComma, + comma, pprAddr addr ] pprInstr (CLR reg) - = uppBesides [ - uppPStr SLIT("\tclr\t"), + = hcat [ + ptext SLIT("\tclr\t"), pprReg reg ] pprInstr (ABS size ri reg) - = uppBesides [ - uppPStr SLIT("\tabs"), + = hcat [ + ptext SLIT("\tabs"), pprSize size, - uppChar '\t', + char '\t', pprRI ri, - uppComma, + comma, pprReg reg ] pprInstr (NEG size ov ri reg) - = uppBesides [ - uppPStr SLIT("\tneg"), + = hcat [ + ptext SLIT("\tneg"), pprSize size, - if ov then uppPStr SLIT("v\t") else uppChar '\t', + if ov then ptext SLIT("v\t") else char '\t', pprRI ri, - uppComma, + comma, pprReg reg ] pprInstr (ADD size ov reg1 ri reg2) - = uppBesides [ - uppPStr SLIT("\tadd"), + = hcat [ + ptext SLIT("\tadd"), pprSize size, - if ov then uppPStr SLIT("v\t") else uppChar '\t', + if ov then ptext SLIT("v\t") else char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] pprInstr (SADD size scale reg1 ri reg2) - = uppBesides [ - uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}), - uppPStr SLIT("add"), + = hcat [ + ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}), + ptext SLIT("add"), pprSize size, - uppChar '\t', + char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] pprInstr (SUB size ov reg1 ri reg2) - = uppBesides [ - uppPStr SLIT("\tsub"), + = hcat [ + ptext SLIT("\tsub"), pprSize size, - if ov then uppPStr SLIT("v\t") else uppChar '\t', + if ov then ptext SLIT("v\t") else char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] pprInstr (SSUB size scale reg1 ri reg2) - = uppBesides [ - uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}), - uppPStr SLIT("sub"), + = hcat [ + ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}), + ptext SLIT("sub"), pprSize size, - uppChar '\t', + char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] pprInstr (MUL size ov reg1 ri reg2) - = uppBesides [ - uppPStr SLIT("\tmul"), + = hcat [ + ptext SLIT("\tmul"), pprSize size, - if ov then uppPStr SLIT("v\t") else uppChar '\t', + if ov then ptext SLIT("v\t") else char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] pprInstr (DIV size uns reg1 ri reg2) - = uppBesides [ - uppPStr SLIT("\tdiv"), + = hcat [ + ptext SLIT("\tdiv"), pprSize size, - if uns then uppPStr SLIT("u\t") else uppChar '\t', + if uns then ptext SLIT("u\t") else char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] pprInstr (REM size uns reg1 ri reg2) - = uppBesides [ - uppPStr SLIT("\trem"), + = hcat [ + ptext SLIT("\trem"), pprSize size, - if uns then uppPStr SLIT("u\t") else uppChar '\t', + if uns then ptext SLIT("u\t") else char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] pprInstr (NOT ri reg) - = uppBesides [ - uppPStr SLIT("\tnot"), - uppChar '\t', + = hcat [ + ptext SLIT("\tnot"), + char '\t', pprRI ri, - uppComma, + comma, pprReg reg ] @@ -679,41 +679,41 @@ 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) = uppPStr SLIT("\tnop") +pprInstr (NOP) = ptext SLIT("\tnop") pprInstr (CMP cond reg1 ri reg2) - = uppBesides [ - uppPStr SLIT("\tcmp"), + = hcat [ + ptext SLIT("\tcmp"), pprCond cond, - uppChar '\t', + char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] pprInstr (FCLR reg) - = uppBesides [ - uppPStr SLIT("\tfclr\t"), + = hcat [ + ptext SLIT("\tfclr\t"), pprReg reg ] pprInstr (FABS reg1 reg2) - = uppBesides [ - uppPStr SLIT("\tfabs\t"), + = hcat [ + ptext SLIT("\tfabs\t"), pprReg reg1, - uppComma, + comma, pprReg reg2 ] pprInstr (FNEG size reg1 reg2) - = uppBesides [ - uppPStr SLIT("\tneg"), + = hcat [ + ptext SLIT("\tneg"), pprSize size, - uppChar '\t', + char '\t', pprReg reg1, - uppComma, + comma, pprReg reg2 ] @@ -723,94 +723,94 @@ pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3 pprInstr (CVTxy size1 size2 reg1 reg2) - = uppBesides [ - uppPStr SLIT("\tcvt"), + = hcat [ + ptext SLIT("\tcvt"), pprSize size1, - case size2 of {Q -> uppPStr SLIT("qc"); _ -> pprSize size2}, - uppChar '\t', + case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2}, + char '\t', pprReg reg1, - uppComma, + comma, pprReg reg2 ] pprInstr (FCMP size cond reg1 reg2 reg3) - = uppBesides [ - uppPStr SLIT("\tcmp"), + = hcat [ + ptext SLIT("\tcmp"), pprSize size, pprCond cond, - uppChar '\t', + char '\t', pprReg reg1, - uppComma, + comma, pprReg reg2, - uppComma, + comma, pprReg reg3 ] pprInstr (FMOV reg1 reg2) - = uppBesides [ - uppPStr SLIT("\tfmov\t"), + = hcat [ + ptext SLIT("\tfmov\t"), pprReg reg1, - uppComma, + comma, pprReg reg2 ] pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab) -pprInstr (BI NEVER reg lab) = uppNil +pprInstr (BI NEVER reg lab) = empty pprInstr (BI cond reg lab) - = uppBesides [ - uppPStr SLIT("\tb"), + = hcat [ + ptext SLIT("\tb"), pprCond cond, - uppChar '\t', + char '\t', pprReg reg, - uppComma, + comma, pprImm lab ] pprInstr (BF cond reg lab) - = uppBesides [ - uppPStr SLIT("\tfb"), + = hcat [ + ptext SLIT("\tfb"), pprCond cond, - uppChar '\t', + char '\t', pprReg reg, - uppComma, + comma, pprImm lab ] pprInstr (BR lab) - = uppBeside (uppPStr SLIT("\tbr\t")) (pprImm lab) + = (<>) (ptext SLIT("\tbr\t")) (pprImm lab) pprInstr (JMP reg addr hint) - = uppBesides [ - uppPStr SLIT("\tjmp\t"), + = hcat [ + ptext SLIT("\tjmp\t"), pprReg reg, - uppComma, + comma, pprAddr addr, - uppComma, - uppInt hint + comma, + int hint ] pprInstr (BSR imm n) - = uppBeside (uppPStr SLIT("\tbsr\t")) (pprImm imm) + = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm) pprInstr (JSR reg addr n) - = uppBesides [ - uppPStr SLIT("\tjsr\t"), + = hcat [ + ptext SLIT("\tjsr\t"), pprReg reg, - uppComma, + comma, pprAddr addr ] pprInstr (FUNBEGIN clab) - = uppBesides [ + = hcat [ if (externallyVisibleCLabel clab) then - uppBesides [uppPStr SLIT("\t.globl\t"), pp_lab, uppChar '\n'] + hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n'] else - uppNil, - uppPStr SLIT("\t.ent "), + empty, + ptext SLIT("\t.ent "), pp_lab, - uppChar '\n', + char '\n', pp_lab, pp_ldgp, pp_lab, @@ -819,46 +819,46 @@ pprInstr (FUNBEGIN clab) where pp_lab = pprCLabel_asm clab - pp_ldgp = uppPStr (pACK_STR (a_HASH ":\n\tldgp $29,0($27)\n"#)) - pp_frame = uppPStr (pACK_STR (a_HASH "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#)) + pp_ldgp = ptext SLIT(":\n\tldgp $29,0($27)\n") + pp_frame = ptext SLIT("..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1") pprInstr (FUNEND clab) - = uppBeside (uppPStr SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab) + = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab) \end{code} Continue with Alpha-only printing bits and bobs: \begin{code} -pprRI :: RI -> Unpretty +pprRI :: RI -> SDoc pprRI (RIReg r) = pprReg r pprRI (RIImm r) = pprImm r -pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Unpretty +pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc pprRegRIReg name reg1 ri reg2 - = uppBesides [ - uppChar '\t', - uppPStr name, - uppChar '\t', + = hcat [ + char '\t', + ptext name, + char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] -pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty +pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc pprSizeRegRegReg name size reg1 reg2 reg3 - = uppBesides [ - uppChar '\t', - uppPStr name, + = hcat [ + char '\t', + ptext name, pprSize size, - uppChar '\t', + char '\t', pprReg reg1, - uppComma, + comma, pprReg reg2, - uppComma, + comma, pprReg reg3 ] @@ -874,9 +874,14 @@ pprSizeRegRegReg name size reg1 reg2 reg3 \begin{code} #if i386_TARGET_ARCH -pprInstr (MOV size (OpReg src) (OpReg dst)) -- hack +pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack | src == dst - = uppPStr SLIT("") + = +#ifdef DEBUG + (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d) +#else + (ptext SLIT("")) +#endif pprInstr (MOV size src dst) = pprSizeOpOp SLIT("mov") size src dst pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst @@ -884,13 +889,13 @@ pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst -- here we do some patching, since the physical registers are only set late -- in the code generation. -pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) +pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) | reg1 == reg3 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst -pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) +pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3)) | reg2 == reg3 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst -pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) Nothing displ)) dst@(OpReg reg3)) +pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3)) | reg1 == reg3 = pprInstr (ADD size (OpImm displ) dst) pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst @@ -910,180 +915,193 @@ pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst pprInstr (NOT size op) = pprSizeOp SLIT("not") size op pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op -pprInstr (SHL size imm dst) = pprSizeOpOp SLIT("shl") size imm dst -pprInstr (SAR size imm dst) = pprSizeOpOp SLIT("sar") size imm dst -pprInstr (SHR size imm dst) = pprSizeOpOp SLIT("shr") size imm dst + +pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst +pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst +pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op pprInstr (POP size op) = pprSizeOp SLIT("pop") size op -pprInstr (NOP) = uppPStr SLIT("\tnop") -pprInstr (CLTD) = uppPStr SLIT("\tcltd") +pprInstr (NOP) = ptext SLIT("\tnop") +pprInstr (CLTD) = ptext SLIT("\tcltd") pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op) pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab) -pprInstr (JMP (OpImm imm)) = uppBeside (uppPStr SLIT("\tjmp ")) (pprImm imm) -pprInstr (JMP op) = uppBeside (uppPStr SLIT("\tjmp *")) (pprOperand L op) +pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) +pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op) pprInstr (CALL imm) - = uppBesides [ uppPStr SLIT("\tcall "), pprImm imm ] + = hcat [ ptext SLIT("\tcall "), pprImm imm ] -pprInstr SAHF = uppPStr SLIT("\tsahf") -pprInstr FABS = uppPStr SLIT("\tfabs") +pprInstr SAHF = ptext SLIT("\tsahf") +pprInstr FABS = ptext SLIT("\tfabs") pprInstr (FADD sz src@(OpAddr _)) - = uppBesides [uppPStr SLIT("\tfadd"), pprSize sz, uppSP, pprOperand sz src] + = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src] pprInstr (FADD sz src) - = uppPStr SLIT("\tfadd") + = ptext SLIT("\tfadd") pprInstr FADDP - = uppPStr SLIT("\tfaddp") + = ptext SLIT("\tfaddp") pprInstr (FMUL sz src) - = uppBesides [uppPStr SLIT("\tfmul"), pprSize sz, uppSP, pprOperand sz src] + = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src] pprInstr FMULP - = uppPStr SLIT("\tfmulp") + = ptext SLIT("\tfmulp") pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op -pprInstr FCHS = uppPStr SLIT("\tfchs") +pprInstr FCHS = ptext SLIT("\tfchs") pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op -pprInstr FCOS = uppPStr SLIT("\tfcos") +pprInstr FCOS = ptext SLIT("\tfcos") pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op pprInstr (FDIV sz src) - = uppBesides [uppPStr SLIT("\tfdiv"), pprSize sz, uppSP, pprOperand sz src] + = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src] pprInstr FDIVP - = uppPStr SLIT("\tfdivp") + = ptext SLIT("\tfdivp") pprInstr (FDIVR sz src) - = uppBesides [uppPStr SLIT("\tfdivr"), pprSize sz, uppSP, pprOperand sz src] + = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src] pprInstr FDIVRP - = uppPStr SLIT("\tfdivpr") + = ptext SLIT("\tfdivpr") pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op pprInstr (FLD sz (OpImm (ImmCLbl src))) - = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprCLabel_asm src] + = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src] pprInstr (FLD sz src) - = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprOperand sz src] -pprInstr FLD1 = uppPStr SLIT("\tfld1") -pprInstr FLDZ = uppPStr SLIT("\tfldz") + = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src] +pprInstr FLD1 = ptext SLIT("\tfld1") +pprInstr FLDZ = ptext SLIT("\tfldz") pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op -pprInstr FRNDINT = uppPStr SLIT("\tfrndint") -pprInstr FSIN = uppPStr SLIT("\tfsin") -pprInstr FSQRT = uppPStr SLIT("\tfsqrt") +pprInstr FRNDINT = ptext SLIT("\tfrndint") +pprInstr FSIN = ptext SLIT("\tfsin") +pprInstr FSQRT = ptext SLIT("\tfsqrt") pprInstr (FST sz dst) - = uppBesides [uppPStr SLIT("\tfst"), pprSize sz, uppSP, pprOperand sz dst] + = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst] pprInstr (FSTP sz dst) - = uppBesides [uppPStr SLIT("\tfstp"), pprSize sz, uppSP, pprOperand sz dst] + = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst] pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op pprInstr (FSUB sz src) - = uppBesides [uppPStr SLIT("\tfsub"), pprSize sz, uppSP, pprOperand sz src] + = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src] pprInstr FSUBP - = uppPStr SLIT("\tfsubp") + = ptext SLIT("\tfsubp") pprInstr (FSUBR size src) = pprSizeOp SLIT("fsubr") size src pprInstr FSUBRP - = uppPStr SLIT("\tfsubpr") + = ptext SLIT("\tfsubpr") pprInstr (FISUBR size op) = pprSizeAddr SLIT("fisubr") size op -pprInstr FTST = uppPStr SLIT("\tftst") +pprInstr FTST = ptext SLIT("\tftst") pprInstr (FCOMP sz op) - = uppBesides [uppPStr SLIT("\tfcomp"), pprSize sz, uppSP, pprOperand sz op] -pprInstr FUCOMPP = uppPStr SLIT("\tfucompp") -pprInstr FXCH = uppPStr SLIT("\tfxch") -pprInstr FNSTSW = uppPStr SLIT("\tfnstsw %ax") -pprInstr FNOP = uppPStr SLIT("") + = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op] +pprInstr FUCOMPP = ptext SLIT("\tfucompp") +pprInstr FXCH = ptext SLIT("\tfxch") +pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax") +pprInstr FNOP = ptext SLIT("") \end{code} Continue with I386-only printing bits and bobs: \begin{code} -pprDollImm :: Imm -> Unpretty +pprDollImm :: Imm -> SDoc -pprDollImm i = uppBesides [ uppPStr SLIT("$"), pprImm i] +pprDollImm i = hcat [ ptext SLIT("$"), pprImm i] -pprOperand :: Size -> Operand -> Unpretty +pprOperand :: Size -> Operand -> SDoc pprOperand s (OpReg r) = pprReg s r pprOperand s (OpImm i) = pprDollImm i pprOperand s (OpAddr ea) = pprAddr ea -pprSizeOp :: FAST_STRING -> Size -> Operand -> Unpretty +pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc pprSizeOp name size op1 - = uppBesides [ - uppChar '\t', - uppPStr name, + = hcat [ + char '\t', + ptext name, pprSize size, - uppSP, + space, pprOperand size op1 ] -pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty +pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc pprSizeOpOp name size op1 op2 - = uppBesides [ - uppChar '\t', - uppPStr name, + = hcat [ + char '\t', + ptext name, pprSize size, - uppSP, + space, pprOperand size op1, - uppComma, + comma, pprOperand size op2 ] -pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Unpretty +pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc +pprSizeByteOpOp name size op1 op2 + = hcat [ + char '\t', + ptext name, + pprSize size, + space, + pprOperand B op1, + comma, + pprOperand size op2 + ] + +pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc pprSizeOpReg name size op1 reg - = uppBesides [ - uppChar '\t', - uppPStr name, + = hcat [ + char '\t', + ptext name, pprSize size, - uppSP, + space, pprOperand size op1, - uppComma, + comma, pprReg size reg ] -pprSizeAddr :: FAST_STRING -> Size -> Addr -> Unpretty +pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc pprSizeAddr name size op - = uppBesides [ - uppChar '\t', - uppPStr name, + = hcat [ + char '\t', + ptext name, pprSize size, - uppSP, + space, pprAddr op ] -pprSizeAddrReg :: FAST_STRING -> Size -> Addr -> Reg -> Unpretty +pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc pprSizeAddrReg name size op dst - = uppBesides [ - uppChar '\t', - uppPStr name, + = hcat [ + char '\t', + ptext name, pprSize size, - uppSP, + space, pprAddr op, - uppComma, + comma, pprReg size dst ] -pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty +pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc pprOpOp name size op1 op2 - = uppBesides [ - uppChar '\t', - uppPStr name, uppSP, + = hcat [ + char '\t', + ptext name, space, pprOperand size op1, - uppComma, + comma, pprOperand size op2 ] -pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Unpretty +pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc pprSizeOpOpCoerce name size1 size2 op1 op2 - = uppBesides [ uppChar '\t', uppPStr name, uppSP, + = hcat [ char '\t', ptext name, space, pprOperand size1 op1, - uppComma, + comma, pprOperand size2 op2 ] -pprCondInstr :: FAST_STRING -> Cond -> Unpretty -> Unpretty +pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc pprCondInstr name cond arg - = uppBesides [ uppChar '\t', uppPStr name, pprCond cond, uppSP, arg] + = hcat [ char '\t', ptext name, pprCond cond, space, arg] #endif {-i386_TARGET_ARCH-} \end{code} @@ -1099,14 +1117,24 @@ pprCondInstr name cond arg -- a clumsy hack for now, to handle possible double alignment problems +-- even clumsier, to allow for RegReg regs that show when doing indexed +-- reads (bytearrays). +-- +pprInstr (LD DF (AddrRegReg g1 g2) reg) + = hcat [ + ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n', + pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n', + pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg) + ] + pprInstr (LD DF addr reg) | maybeToBool off_addr - = uppBesides [ + = hcat [ pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg, - uppChar '\n', + char '\n', pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma, @@ -1117,11 +1145,11 @@ pprInstr (LD DF addr reg) | maybeToBool off_addr addr2 = case off_addr of Just x -> x pprInstr (LD size addr reg) - = uppBesides [ - uppPStr SLIT("\tld"), + = hcat [ + ptext SLIT("\tld"), pprSize size, - uppChar '\t', - uppLbrack, + char '\t', + lbrack, pprAddr addr, pp_rbracket_comma, pprReg reg @@ -1129,45 +1157,55 @@ pprInstr (LD size addr reg) -- The same clumsy hack as above -pprInstr (ST DF reg addr) | maybeToBool off_addr - = uppBesides [ - uppPStr SLIT("\tst\t"), - pprReg reg, - pp_comma_lbracket, - pprAddr addr, +pprInstr (ST DF reg (AddrRegReg g1 g2)) + = hcat [ + ptext SLIT("\tadd\t"), + pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n', + ptext SLIT("\tst\t"), + pprReg reg, pp_comma_lbracket, pprReg g1, + ptext SLIT("]\n\tst\t"), + pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]") + ] - uppPStr SLIT("]\n\tst\t"), - pprReg (fPair reg), - pp_comma_lbracket, - pprAddr addr2, - uppRbrack +pprInstr (ST DF reg addr) | maybeToBool off_addr + = hcat [ + ptext SLIT("\tst\t"), + pprReg reg, pp_comma_lbracket, pprAddr addr, + + ptext SLIT("]\n\tst\t"), + pprReg (fPair reg), pp_comma_lbracket, + pprAddr addr2, rbrack ] where off_addr = addrOffset addr 4 addr2 = case off_addr of Just x -> x +-- 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.. + pprInstr (ST size reg addr) - = uppBesides [ - uppPStr SLIT("\tst"), - pprSize size, - uppChar '\t', + = hcat [ + ptext SLIT("\tst"), + pprStSize size, + char '\t', pprReg reg, pp_comma_lbracket, pprAddr addr, - uppRbrack + rbrack ] pprInstr (ADD x cc reg1 ri reg2) | not x && not cc && riZero ri - = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ] + = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ] | otherwise = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2 pprInstr (SUB x cc reg1 ri reg2) | not x && cc && reg2 == g0 - = uppBesides [ uppPStr SLIT("\tcmp\t"), pprReg reg1, uppComma, pprRI ri ] + = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ] | not x && not cc && riZero ri - = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ] + = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ] | otherwise = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2 @@ -1176,7 +1214,7 @@ pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2 pprInstr (OR b reg1 ri reg2) | not b && reg1 == g0 - = uppBesides [ uppPStr SLIT("\tmov\t"), pprRI ri, uppComma, pprReg reg2 ] + = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ] | otherwise = pprRegRIReg SLIT("or") b reg1 ri reg2 @@ -1190,20 +1228,20 @@ pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2 pprInstr (SETHI imm reg) - = uppBesides [ - uppPStr SLIT("\tsethi\t"), + = hcat [ + ptext SLIT("\tsethi\t"), pprImm imm, - uppComma, + comma, pprReg reg ] -pprInstr NOP = uppPStr SLIT("\tnop") +pprInstr NOP = ptext SLIT("\tnop") pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2 pprInstr (FABS DF reg1 reg2) - = uppBeside (pprSizeRegReg SLIT("fabs") F reg1 reg2) - (if (reg1 == reg2) then uppNil - else uppBeside (uppChar '\n') + = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2) + (if (reg1 == reg2) then empty + else (<>) (char '\n') (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2))) pprInstr (FADD size reg1 reg2 reg3) @@ -1215,9 +1253,9 @@ pprInstr (FDIV size reg1 reg2 reg3) pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2 pprInstr (FMOV DF reg1 reg2) - = uppBeside (pprSizeRegReg SLIT("fmov") F reg1 reg2) - (if (reg1 == reg2) then uppNil - else uppBeside (uppChar '\n') + = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2) + (if (reg1 == reg2) then empty + else (<>) (char '\n') (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2))) pprInstr (FMUL size reg1 reg2 reg3) @@ -1225,114 +1263,114 @@ pprInstr (FMUL size reg1 reg2 reg3) pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2 pprInstr (FNEG DF reg1 reg2) - = uppBeside (pprSizeRegReg SLIT("fneg") F reg1 reg2) - (if (reg1 == reg2) then uppNil - else uppBeside (uppChar '\n') + = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2) + (if (reg1 == reg2) then empty + else (<>) (char '\n') (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2))) pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3 pprInstr (FxTOy size1 size2 reg1 reg2) - = uppBesides [ - uppPStr SLIT("\tf"), - uppPStr + = hcat [ + ptext SLIT("\tf"), + ptext (case size1 of W -> SLIT("ito") F -> SLIT("sto") DF -> SLIT("dto")), - uppPStr + ptext (case size2 of W -> SLIT("i\t") F -> SLIT("s\t") DF -> SLIT("d\t")), - pprReg reg1, uppComma, pprReg reg2 + pprReg reg1, comma, pprReg reg2 ] pprInstr (BI cond b lab) - = uppBesides [ - uppPStr SLIT("\tb"), pprCond cond, - if b then pp_comma_a else uppNil, - uppChar '\t', + = hcat [ + ptext SLIT("\tb"), pprCond cond, + if b then pp_comma_a else empty, + char '\t', pprImm lab ] pprInstr (BF cond b lab) - = uppBesides [ - uppPStr SLIT("\tfb"), pprCond cond, - if b then pp_comma_a else uppNil, - uppChar '\t', + = hcat [ + ptext SLIT("\tfb"), pprCond cond, + if b then pp_comma_a else empty, + char '\t', pprImm lab ] -pprInstr (JMP addr) = uppBeside (uppPStr SLIT("\tjmp\t")) (pprAddr addr) +pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr) pprInstr (CALL imm n _) - = uppBesides [ uppPStr SLIT("\tcall\t"), pprImm imm, uppComma, uppInt n ] + = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ] \end{code} Continue with SPARC-only printing bits and bobs: \begin{code} -pprRI :: RI -> Unpretty +pprRI :: RI -> SDoc pprRI (RIReg r) = pprReg r pprRI (RIImm r) = pprImm r -pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Unpretty +pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc pprSizeRegReg name size reg1 reg2 - = uppBesides [ - uppChar '\t', - uppPStr name, + = hcat [ + char '\t', + ptext name, (case size of - F -> uppPStr SLIT("s\t") - DF -> uppPStr SLIT("d\t")), + F -> ptext SLIT("s\t") + DF -> ptext SLIT("d\t")), pprReg reg1, - uppComma, + comma, pprReg reg2 ] -pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty +pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc pprSizeRegRegReg name size reg1 reg2 reg3 - = uppBesides [ - uppChar '\t', - uppPStr name, + = hcat [ + char '\t', + ptext name, (case size of - F -> uppPStr SLIT("s\t") - DF -> uppPStr SLIT("d\t")), + F -> ptext SLIT("s\t") + DF -> ptext SLIT("d\t")), pprReg reg1, - uppComma, + comma, pprReg reg2, - uppComma, + comma, pprReg reg3 ] -pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Unpretty +pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc pprRegRIReg name b reg1 ri reg2 - = uppBesides [ - uppChar '\t', - uppPStr name, - if b then uppPStr SLIT("cc\t") else uppChar '\t', + = hcat [ + char '\t', + ptext name, + if b then ptext SLIT("cc\t") else char '\t', pprReg reg1, - uppComma, + comma, pprRI ri, - uppComma, + comma, pprReg reg2 ] -pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Unpretty +pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc pprRIReg name b ri reg1 - = uppBesides [ - uppChar '\t', - uppPStr name, - if b then uppPStr SLIT("cc\t") else uppChar '\t', + = hcat [ + char '\t', + ptext name, + if b then ptext SLIT("cc\t") else char '\t', pprRI ri, - uppComma, + comma, pprReg reg1 ] -pp_ld_lbracket = uppPStr (pACK_STR (a_HASH "\tld\t["#)) -pp_rbracket_comma = uppPStr (pACK_STR (a_HASH "],"#)) -pp_comma_lbracket = uppPStr (pACK_STR (a_HASH ",["#)) -pp_comma_a = uppPStr (pACK_STR (a_HASH ",a"#)) +pp_ld_lbracket = ptext SLIT("\tld\t[") +pp_rbracket_comma = text "]," +pp_comma_lbracket = text ",[" +pp_comma_a = text ",a" #endif {-sparc_TARGET_ARCH-} \end{code}