Updated to reflect MachRegs.Addr to MachRegs.Address renaming; x86 shift instructions need special treatment to get at %cl; added DEBUG msg if x86 MOV %r,%r instruction generated
import qualified GHCbase(Addr(..)) -- to see innards
IMP_Ubiq(){-uitious-}
#elif __GLASGOW_HASKELL__ >= 202
import qualified GHCbase(Addr(..)) -- to see innards
IMP_Ubiq(){-uitious-}
#elif __GLASGOW_HASKELL__ >= 202
-import qualified GlaExts (Addr(..))
-import GlaExts hiding (Addr(..))
import FastString
#else
IMP_Ubiq(){-uitious-}
import FastString
#else
IMP_Ubiq(){-uitious-}
#if __GLASGOW_HASKELL__ == 201
a_HASH x = GHCbase.A# x
pACK_STR x = packCString x
#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
#else
a_HASH x = A# x
pACK_STR x = mkFastCharString x --_packCString x
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
+pprAddr :: Address -> Doc
#if alpha_TARGET_ARCH
pprAddr (AddrReg r) = parens (pprReg r)
#if alpha_TARGET_ARCH
pprAddr (AddrReg r) = parens (pprReg r)
else
hcat [pp_imm, char '+', int off]
else
hcat [pp_imm, char '+', int off]
-pprAddr (Addr base index displacement)
+pprAddr (Address base index displacement)
= let
pp_disp = ppr_disp displacement
pp_off p = (<>) pp_disp (parens p)
= let
pp_disp = ppr_disp displacement
pp_off p = (<>) pp_disp (parens p)
\begin{code}
pprInstr :: Instr -> Doc
\begin{code}
pprInstr :: Instr -> Doc
+--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 (COMMENT s) = empty -- nuke 'em
--alpha: = (<>) (ptext SLIT("\t# ")) (ptext s)
--i386 : = (<>) (ptext SLIT("# ")) (ptext s)
\begin{code}
#if i386_TARGET_ARCH
\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
+ =
+#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
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.
-- 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 (Address src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
| reg1 == reg3
= pprSizeOpOp SLIT("add") size (OpReg reg2) dst
| 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 (Address src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
| reg2 == reg3
= pprSizeOpOp SLIT("add") size (OpReg reg1) dst
| 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 (Address 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
| 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 (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 (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
+pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
+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 -> Doc
pprSizeOpReg name size op1 reg
= hcat [
pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc
pprSizeOpReg name size op1 reg
= hcat [
-pprSizeAddr :: FAST_STRING -> Size -> Addr -> Doc
+pprSizeAddr :: FAST_STRING -> Size -> Address -> Doc
pprSizeAddr name size op
= hcat [
char '\t',
pprSizeAddr name size op
= hcat [
char '\t',
-pprSizeAddrReg :: FAST_STRING -> Size -> Addr -> Reg -> Doc
+pprSizeAddrReg :: FAST_STRING -> Size -> Address -> Reg -> Doc
pprSizeAddrReg name size op dst
= hcat [
char '\t',
pprSizeAddrReg name size op dst
= hcat [
char '\t',