\begin{code}
#include "nativeGen/NCG.h"
-module PprMach ( pprInstr ) where
+module PprMach ( pprInstr, pprSize, pprUserReg ) where
#include "HsVersions.h"
For x86, the way we print a register name depends
on which bit of it we care about. Yurgh.
\begin{code}
+pprUserReg:: Reg -> SDoc
+pprUserReg = pprReg IF_ARCH_i386(L,)
+
+
pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc
pprReg IF_ARCH_i386(s,) r
_ -> SLIT("very naughty I386 byte register")
})
-{- UNUSED:
- 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");
- _ -> SLIT("very naughty I386 high byte register")
- })
--}
-
-{- UNUSED:
- 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");
- ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
- ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
- _ -> SLIT("very naughty I386 word register")
- })
--}
-
- ppr_reg_no L i = ptext
+ ppr_reg_no _ i = ptext
(case i of {
ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
- _ -> SLIT("very naughty I386 double word register")
- })
-
- ppr_reg_no F i = ptext
- (case i of {
ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1");
ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3");
ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5");
- _ -> SLIT("very naughty I386 float register")
- })
-
- ppr_reg_no DF i = ptext
- (case i of {
- ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1");
- ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3");
- ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5");
- _ -> SLIT("very naughty I386 float register")
+ _ -> SLIT("very naughty I386 register")
})
#endif
#if sparc_TARGET_ARCH
TF -> SLIT("t")
#endif
#if i386_TARGET_ARCH
- B -> SLIT("b")
--- HB -> SLIT("b") UNUSED
--- S -> SLIT("w") UNUSED
- L -> SLIT("l")
- F -> SLIT("s")
- DF -> SLIT("l")
+ B -> SLIT("b")
+-- HB -> SLIT("b") UNUSED
+-- S -> SLIT("w") UNUSED
+ L -> SLIT("l")
+ F -> SLIT("s")
+ DF -> SLIT("l")
+ F80 -> SLIT("t")
#endif
#if sparc_TARGET_ARCH
B -> SLIT("sb")
#if i386_TARGET_ARCH
pprAddr (ImmAddr imm off)
- = let
- pp_imm = pprImm imm
+ = let pp_imm = pprImm imm
in
if (off == 0) then
pp_imm
else if (off < 0) then
- (<>) pp_imm (int off)
+ pp_imm <> int off
else
- hcat [pp_imm, char '+', int off]
+ pp_imm <> char '+' <> int off
pprAddr (AddrBaseIndex base index displacement)
= let
pp_disp = ppr_disp displacement
- pp_off p = (<>) pp_disp (parens p)
+ pp_off p = pp_disp <> char '(' <> p <> char ')'
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 (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])
+ (Nothing, Just (r,i)) -> pp_off (pp_reg r <> comma <> int i)
+ (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
+ <> comma <> int i)
where
ppr_disp (ImmInt 0) = empty
ppr_disp imm = pprImm imm
,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ptext s))
,)))
+pprInstr (DELTA d)
+ = pprInstr (COMMENT (_PK_ ("\tdelta = " ++ show d)))
+
pprInstr (SEGMENT TextSegment)
- = 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(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
- ,)))
+ = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
+ ,IF_ARCH_sparc(ptext SLIT("\t.text\n\t.align 4") {-word boundary-}
+ ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
+ ,)))
pprInstr (SEGMENT DataSegment)
= ptext
#ifdef DEBUG
(<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
#else
- (ptext SLIT(""))
+ empty
#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 (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
+pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
+pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
-- here we do some patching, since the physical registers are only set late
-- in the code generation.
pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
-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 (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst
+pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst
+pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst
+pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
-
pprInstr (CALL imm)
- = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
- ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)"),
- hcat [ ptext SLIT("\tcall "), pprImm imm ]
- ]
+ = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
-- Simulating a flat register set on the x86 FP stack is tricky.
= pprG g (hcat [gtab, gpush src 0, gsemi,
text "fstp", pprSize sz, gsp, pprAddr addr])
+pprInstr g@(GLDZ dst)
+ = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
+pprInstr g@(GLD1 dst)
+ = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
+
pprInstr g@(GFTOD src dst)
= pprG g bogus
pprInstr g@(GFTOI src dst)
= pprG g bogus
pprInstr g@(GITOF src dst)
- = pprG g bogus
+ = pprInstr (GITOD src dst)
pprInstr g@(GITOD src dst)
- = pprG g bogus
+ = pprG g (hcat [gtab, text "pushl ", pprReg L src,
+ text " ; ffree %st(7); fildl (%esp) ; ",
+ gpop dst 1, text " ; addl $4,%esp"])
pprInstr g@(GCMP sz src1 src2)
= pprG g (hcat [gtab, text "pushl %eax ; ",
= pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
pprInstr g@(GNEG sz src dst)
= pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
+
pprInstr g@(GSQRT sz src dst)
- = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt ; ", gpop dst 1])
+ = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
+ hcat [gtab, gcoerceto sz, gpop dst 1])
+pprInstr g@(GSIN sz src dst)
+ = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
+ hcat [gtab, gcoerceto sz, gpop dst 1])
+pprInstr g@(GCOS sz src dst)
+ = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
+ hcat [gtab, gcoerceto sz, gpop dst 1])
+pprInstr g@(GTAN sz src dst)
+ = pprG g (hcat [gtab, text "ffree %st(6) ; ",
+ gpush src 0, text " ; fptan ; ",
+ text " fstp %st(0)"] $$
+ hcat [gtab, gcoerceto sz, gpop dst 1])
pprInstr g@(GADD sz src1 src2 dst)
= pprG g (hcat [gtab, gpush src1 0,
text " ; fdiv ", greg src2 1, text ",%st(0)",
gsemi, gpop dst 1])
+pprInstr GFREE
+ = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
+ ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
+ ]
+
--------------------------
+
+-- coerce %st(0) to the specified size
+gcoerceto DF = empty
+gcoerceto F = text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
+
gpush reg offset
= hcat [text "ffree %st(7) ; fld ", greg reg offset]
gpop reg offset
gsp = char ' '
gregno (FixedReg i) = I# i
gregno (MappedReg i) = I# i
+gregno other = pprPanic "gregno" (text (show other))
pprG :: Instr -> SDoc -> SDoc
pprG fake actual
pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
+pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst
+pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst
+
pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
+pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
+pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
+pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
\begin{code}
pprDollImm :: Imm -> SDoc
-pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
+pprDollImm i = ptext SLIT("$") <> pprImm i
pprOperand :: Size -> Operand -> SDoc
-pprOperand s (OpReg r) = pprReg s r
-pprOperand s (OpImm i) = pprDollImm i
+pprOperand s (OpReg r) = pprReg s r
+pprOperand s (OpImm i) = pprDollImm i
pprOperand s (OpAddr ea) = pprAddr ea
+pprSizeImmOp :: FAST_STRING -> Size -> Imm -> Operand -> SDoc
+pprSizeImmOp name size imm op1
+ = hcat [
+ char '\t',
+ ptext name,
+ pprSize size,
+ space,
+ char '$',
+ pprImm imm,
+ comma,
+ pprOperand size op1
+ ]
+
pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
pprSizeOp name size op1
= hcat [
pprReg size reg
]
+pprSizeReg :: FAST_STRING -> Size -> Reg -> SDoc
+pprSizeReg name size reg1
+ = hcat [
+ char '\t',
+ ptext name,
+ pprSize size,
+ space,
+ pprReg size reg1
+ ]
+
pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
pprSizeRegReg name size reg1 reg2
= hcat [
pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
pprSizeOpOpCoerce name size1 size2 op1 op2
- = hcat [ char '\t', ptext name, space,
+ = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
pprOperand size1 op1,
comma,
pprOperand size2 op2
projects / ghc-hetmet.git / blobdiff