@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 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 Char ( isPrint, isDigit )
+import Outputable
\end{code}
%************************************************************************
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
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");
})
#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");
})
#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");
%************************************************************************
\begin{code}
-pprSize :: Size -> Doc
+pprSize :: Size -> SDoc
pprSize x = ptext (case x of
#if alpha_TARGET_ARCH
-- 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")
%************************************************************************
\begin{code}
-pprCond :: Cond -> Doc
+pprCond :: Cond -> SDoc
pprCond c = ptext (case c of {
#if alpha_TARGET_ARCH
%************************************************************************
\begin{code}
-pprImm :: Imm -> Doc
+pprImm :: Imm -> SDoc
pprImm (ImmInt i) = int i
pprImm (ImmInteger i) = integer i
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}
%************************************************************************
\begin{code}
-pprAddr :: Addr -> Doc
+pprAddr :: MachRegsAddr -> SDoc
#if alpha_TARGET_ARCH
pprAddr (AddrReg r) = parens (pprReg r)
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)
%************************************************************************
\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)
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))
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)
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 [
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 [
\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
-- 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
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
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',
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',
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',
pprReg size reg
]
-pprSizeAddr :: FAST_STRING -> Size -> Addr -> Doc
+pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
pprSizeAddr name size op
= hcat [
char '\t',
pprAddr op
]
-pprSizeAddrReg :: FAST_STRING -> Size -> Addr -> Reg -> Doc
+pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
pprSizeAddrReg name size op dst
= hcat [
char '\t',
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',
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,
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]
-- 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
= hcat [
pp_ld_lbracket,
-- The same clumsy hack as above
-pprInstr (ST DF reg addr) | maybeToBool off_addr
- = hcat [
+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]")
+ ]
+
+pprInstr (ST DF reg addr) | maybeToBool off_addr
+ = hcat [
ptext SLIT("\tst\t"),
- pprReg reg,
- pp_comma_lbracket,
- pprAddr addr,
+ pprReg reg, pp_comma_lbracket, pprAddr addr,
ptext SLIT("]\n\tst\t"),
- pprReg (fPair reg),
- pp_comma_lbracket,
- pprAddr addr2,
- rbrack
+ pprReg (fPair reg), pp_comma_lbracket,
+ pprAddr addr2, rbrack
]
where
off_addr = addrOffset addr 4
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',
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',
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',
pprReg reg2
]
-pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc
+pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
pprRIReg name b ri reg1
= hcat [
char '\t',
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}
projects / ghc-hetmet.git / blobdiff