X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.lhs;h=700700e2f5c06c03ee084fac652d1204433e23f2;hb=438596897ebbe25a07e1c82085cfbc5bdb00f09e;hp=a016d3e3603d85f62421cd15571306fa3dfab406;hpb=9bb0cb7c70f70b531fb032dd14c052a3e696193d;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index a016d3e..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,45 +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 -IMPORT_1_3(Char(isPrint,isDigit)) -#if __GLASGOW_HASKELL__ == 201 -import qualified GHCbase(Addr(..)) -- to see innards -IMP_Ubiq(){-uitious-} -#elif __GLASGOW_HASKELL__ >= 202 -import qualified GlaExts (Addr(..)) -import GlaExts hiding (Addr(..)) -import FastString -import Ubiq -#else -IMP_Ubiq(){-uitious-} -#endif +#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 Pretty -- all of it - -#if __GLASGOW_HASKELL__ == 201 -a_HASH x = GHCbase.A# x -pACK_STR x = packCString x -#elif __GLASGOW_HASKELL__ >= 202 -a_HASH x = GlaExts.A# x -pACK_STR x = mkFastCharString 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} %************************************************************************ @@ -58,7 +34,7 @@ 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 -> Doc +pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc pprReg IF_ARCH_i386(s,) r = case r of @@ -67,7 +43,7 @@ pprReg IF_ARCH_i386(s,) r other -> text (show other) -- should only happen when debugging where #if alpha_TARGET_ARCH - ppr_reg_no :: FAST_REG_NO -> Doc + ppr_reg_no :: FAST_REG_NO -> SDoc ppr_reg_no i = ptext (case i of { ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1"); @@ -106,7 +82,7 @@ pprReg IF_ARCH_i386(s,) r }) #endif #if i386_TARGET_ARCH - ppr_reg_no :: Size -> FAST_REG_NO -> Doc + 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"); @@ -164,7 +140,7 @@ pprReg IF_ARCH_i386(s,) r }) #endif #if sparc_TARGET_ARCH - ppr_reg_no :: FAST_REG_NO -> Doc + ppr_reg_no :: FAST_REG_NO -> SDoc ppr_reg_no i = ptext (case i of { ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1"); @@ -211,7 +187,7 @@ pprReg IF_ARCH_i386(s,) r %************************************************************************ \begin{code} -pprSize :: Size -> Doc +pprSize :: Size -> SDoc pprSize x = ptext (case x of #if alpha_TARGET_ARCH @@ -245,7 +221,7 @@ pprSize x = ptext (case x of -- D -> SLIT("d") UNUSED DF -> SLIT("d") ) -pprStSize :: Size -> Doc +pprStSize :: Size -> SDoc pprStSize x = ptext (case x of B -> SLIT("b") BU -> SLIT("b") @@ -266,7 +242,7 @@ pprStSize x = ptext (case x of %************************************************************************ \begin{code} -pprCond :: Cond -> Doc +pprCond :: Cond -> SDoc pprCond c = ptext (case c of { #if alpha_TARGET_ARCH @@ -308,11 +284,12 @@ pprCond c = ptext (case c of { %************************************************************************ \begin{code} -pprImm :: Imm -> Doc +pprImm :: Imm -> SDoc 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 = (<>) (char '_') s @@ -322,12 +299,12 @@ pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s pprImm (LO i) = hcat [ pp_lo, pprImm i, rparen ] where - pp_lo = ptext (pACK_STR (a_HASH "%lo("#)) + pp_lo = text "%lo(" pprImm (HI i) = hcat [ pp_hi, pprImm i, rparen ] where - pp_hi = ptext (pACK_STR (a_HASH "%hi("#)) + pp_hi = text "%hi(" #endif \end{code} @@ -338,7 +315,7 @@ pprImm (HI i) %************************************************************************ \begin{code} -pprAddr :: Addr -> Doc +pprAddr :: MachRegsAddr -> SDoc #if alpha_TARGET_ARCH pprAddr (AddrReg r) = parens (pprReg r) @@ -361,7 +338,7 @@ pprAddr (ImmAddr imm off) else 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 = (<>) pp_disp (parens p) @@ -411,8 +388,9 @@ pprAddr (AddrRegImm r1 imm) %************************************************************************ \begin{code} -pprInstr :: Instr -> Doc +pprInstr :: Instr -> SDoc +--pprInstr (COMMENT s) = (<>) (ptext SLIT("# ")) (ptext s) pprInstr (COMMENT s) = empty -- nuke 'em --alpha: = (<>) (ptext SLIT("\t# ")) (ptext s) --i386 : = (<>) (ptext SLIT("# ")) (ptext s) @@ -456,14 +434,14 @@ pprInstr (ASCII False{-no backslash conversion-} str) pprInstr (ASCII True str) = (<>) (text "\t.ascii \"") (asciify str 60) where - asciify :: String -> Int -> Doc + 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] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-} asciify (c:(cs@(d:_))) n | isDigit d = (<>) (text (charToC c)) (asciify cs 0) | otherwise = (<>) (text (charToC c)) (asciify cs (n-1)) @@ -490,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 @@ -841,8 +819,8 @@ pprInstr (FUNBEGIN clab) where pp_lab = pprCLabel_asm clab - pp_ldgp = ptext (pACK_STR (a_HASH ":\n\tldgp $29,0($27)\n"#)) - pp_frame = ptext (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) = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab) @@ -850,12 +828,12 @@ pprInstr (FUNEND clab) Continue with Alpha-only printing bits and bobs: \begin{code} -pprRI :: RI -> Doc +pprRI :: RI -> SDoc pprRI (RIReg r) = pprReg r pprRI (RIImm r) = pprImm r -pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Doc +pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc pprRegRIReg name reg1 ri reg2 = hcat [ @@ -869,7 +847,7 @@ pprRegRIReg name reg1 ri reg2 pprReg reg2 ] -pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc +pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc pprSizeRegRegReg name size reg1 reg2 reg3 = hcat [ @@ -896,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 - = ptext 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 @@ -906,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 @@ -932,9 +915,10 @@ 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 @@ -1020,16 +1004,16 @@ pprInstr FNOP = ptext SLIT("") Continue with I386-only printing bits and bobs: \begin{code} -pprDollImm :: Imm -> Doc +pprDollImm :: Imm -> SDoc pprDollImm i = hcat [ ptext SLIT("$"), pprImm i] -pprOperand :: Size -> Operand -> Doc +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 -> Doc +pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc pprSizeOp name size op1 = hcat [ char '\t', @@ -1039,7 +1023,7 @@ pprSizeOp name size op1 pprOperand size op1 ] -pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc +pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc pprSizeOpOp name size op1 op2 = hcat [ char '\t', @@ -1051,7 +1035,19 @@ pprSizeOpOp name size op1 op2 pprOperand size op2 ] -pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc +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 = hcat [ char '\t', @@ -1063,7 +1059,7 @@ pprSizeOpReg name size op1 reg pprReg size reg ] -pprSizeAddr :: FAST_STRING -> Size -> Addr -> Doc +pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc pprSizeAddr name size op = hcat [ char '\t', @@ -1073,7 +1069,7 @@ pprSizeAddr name size op pprAddr op ] -pprSizeAddrReg :: FAST_STRING -> Size -> Addr -> Reg -> Doc +pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc pprSizeAddrReg name size op dst = hcat [ char '\t', @@ -1085,7 +1081,7 @@ pprSizeAddrReg name size op dst pprReg size dst ] -pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc +pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc pprOpOp name size op1 op2 = hcat [ char '\t', @@ -1095,7 +1091,7 @@ pprOpOp name size op1 op2 pprOperand size op2 ] -pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc +pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc pprSizeOpOpCoerce name size1 size2 op1 op2 = hcat [ char '\t', ptext name, space, pprOperand size1 op1, @@ -1103,7 +1099,7 @@ pprSizeOpOpCoerce name size1 size2 op1 op2 pprOperand size2 op2 ] -pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc +pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc pprCondInstr name cond arg = hcat [ char '\t', ptext name, pprCond cond, space, arg] @@ -1315,11 +1311,11 @@ pprInstr (CALL imm n _) Continue with SPARC-only printing bits and bobs: \begin{code} -pprRI :: RI -> Doc +pprRI :: RI -> SDoc pprRI (RIReg r) = pprReg r pprRI (RIImm r) = pprImm r -pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc +pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc pprSizeRegReg name size reg1 reg2 = hcat [ char '\t', @@ -1332,7 +1328,7 @@ pprSizeRegReg name size reg1 reg2 pprReg reg2 ] -pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc +pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc pprSizeRegRegReg name size reg1 reg2 reg3 = hcat [ char '\t', @@ -1347,7 +1343,7 @@ pprSizeRegRegReg name size reg1 reg2 reg3 pprReg reg3 ] -pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc +pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc pprRegRIReg name b reg1 ri reg2 = hcat [ char '\t', @@ -1360,7 +1356,7 @@ pprRegRIReg name b reg1 ri reg2 pprReg reg2 ] -pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc +pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc pprRIReg name b ri reg1 = hcat [ char '\t', @@ -1371,10 +1367,10 @@ pprRIReg name b ri reg1 pprReg reg1 ] -pp_ld_lbracket = ptext (pACK_STR (a_HASH "\tld\t["#)) -pp_rbracket_comma = ptext (pACK_STR (a_HASH "],"#)) -pp_comma_lbracket = ptext (pACK_STR (a_HASH ",["#)) -pp_comma_a = ptext (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}