X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.lhs;h=ea296ef27a632a18aa6c2deeddc4fff6b1177257;hb=4070b105490709e2fbc40ef926853fc93595b7a6;hp=13d8dfb770296c3bafd435a979b45bbbf46da91b;hpb=70d8d35f7636bd67d6bef0a73fafed7d09927da1;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 13d8dfb..ea296ef 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -10,7 +10,7 @@ We start with the @pprXXX@s with some cross-platform commonality \begin{code} #include "nativeGen/NCG.h" -module PprMach ( pprInstr ) where +module PprMach ( pprInstr, pprSize, pprUserReg ) where #include "HsVersions.h" @@ -38,6 +38,10 @@ import Char ( ord ) 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 @@ -94,49 +98,16 @@ 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 @@ -204,12 +175,13 @@ pprSize x = ptext (case x of 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") @@ -328,27 +300,27 @@ pprAddr (AddrRegImm r1 i) #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 @@ -397,12 +369,14 @@ pprInstr (COMMENT s) ,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 @@ -942,12 +916,12 @@ 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("")) + 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. @@ -978,9 +952,10 @@ 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) = 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 @@ -998,12 +973,8 @@ pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab) 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. @@ -1025,6 +996,11 @@ pprInstr g@(GST sz src addr) = 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) @@ -1036,9 +1012,11 @@ pprInstr g@(GDTOI 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 ; ", @@ -1050,8 +1028,21 @@ pprInstr g@(GABS sz src dst) = 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, @@ -1070,7 +1061,17 @@ pprInstr g@(GDIV sz src1 src2 dst) 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 @@ -1083,6 +1084,7 @@ gtab = char '\t' 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 @@ -1092,6 +1094,9 @@ pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst 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 @@ -1105,6 +1110,9 @@ pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz 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 @@ -1116,13 +1124,26 @@ Continue with I386-only printing bits and bobs: \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 [ @@ -1169,6 +1190,16 @@ pprSizeOpReg name size op1 reg 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 [ @@ -1254,7 +1285,7 @@ pprOpOp name size op1 op2 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