X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPprMach.lhs;h=722128cab26c65ac5c6dc0141e3ce482c2b4a929;hb=a237946da277f10bd3d223e5926d118044d24194;hp=393335181f5d96181b567b8247b17b5376ba41e2;hpb=298e7a785bd89b51e0e8c34980cd4ceac7d3dce0;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PprMach.lhs b/ghc/compiler/nativeGen/PprMach.lhs index 3933351..722128c 100644 --- a/ghc/compiler/nativeGen/PprMach.lhs +++ b/ghc/compiler/nativeGen/PprMach.lhs @@ -10,23 +10,22 @@ We start with the @pprXXX@s with some cross-platform commonality \begin{code} #include "nativeGen/NCG.h" -module PprMach ( pprInstr, pprSize ) where +module PprMach ( pprInstr, pprSize, pprUserReg ) where #include "HsVersions.h" import MachRegs -- may differ per-platform import MachMisc -import CLabel ( pprCLabel_asm, externallyVisibleCLabel ) -import CStrings ( charToC ) -import Maybes ( maybeToBool ) +import CLabel ( pprCLabel_asm, externallyVisibleCLabel, labelDynamic ) import Stix ( CodeSegment(..), StixTree(..) ) import Char ( isPrint, isDigit ) import Outputable import ST import MutableArray -import Char ( ord ) +import Char ( chr, ord ) +import Maybe ( isJust ) \end{code} %************************************************************************ @@ -38,13 +37,17 @@ 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 = case r of - FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i - MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i - other -> text (show other) -- should only happen when debugging + RealReg (I# i) -> ppr_reg_no IF_ARCH_i386(s,) i + VirtualRegI u -> text "%vI_" <> ppr u + VirtualRegF u -> text "%vF_" <> ppr u where #if alpha_TARGET_ARCH ppr_reg_no :: FAST_REG_NO -> SDoc @@ -87,56 +90,23 @@ pprReg IF_ARCH_i386(s,) r #endif #if i386_TARGET_ARCH ppr_reg_no :: Size -> FAST_REG_NO -> SDoc - ppr_reg_no B i = ptext + ppr_reg_no B i= ptext (case i of { ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl"); ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl"); _ -> 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 @@ -195,7 +165,7 @@ pprSize x = ptext (case x of BU -> SLIT("bu") -- W -> SLIT("w") UNUSED -- WU -> SLIT("wu") UNUSED --- L -> SLIT("l") UNUSED + L -> SLIT("l") Q -> SLIT("q") -- FF -> SLIT("f") UNUSED -- DF -> SLIT("d") UNUSED @@ -204,12 +174,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") @@ -288,12 +259,15 @@ 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 (ImmCLbl l) = (if labelDynamic l then text "__imp_" else empty) + <> pprCLabel_asm l +pprImm (ImmIndex l i) = (if labelDynamic l then text "__imp_" else empty) + <> pprCLabel_asm l <> char '+' <> int i pprImm (ImmLit s) = s -pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s - | otherwise = s +pprImm (ImmLab dll s) = (if underscorePrefix then char '_' else empty) + <> (if dll then text "_imp__" else empty) + <> s #if sparc_TARGET_ARCH pprImm (LO i) @@ -328,27 +302,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 @@ -357,7 +331,7 @@ pprAddr (AddrBaseIndex base index displacement) ------------------- #if sparc_TARGET_ARCH -pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1 +pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1 pprAddr (AddrRegReg r1 r2) = hcat [ pprReg r1, char '+', pprReg r2 ] @@ -397,16 +371,19 @@ pprInstr (COMMENT s) ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ptext s)) ,))) +pprInstr (DELTA d) + = pprInstr (COMMENT (_PK_ ("\tdelta = " ++ show d))) + pprInstr (SEGMENT TextSegment) = 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_sparc(ptext SLIT(".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 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3") - ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -} + ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -} ,IF_ARCH_i386(SLIT(".data\n\t.align 4") ,))) @@ -421,7 +398,7 @@ pprInstr (LABEL clab) hcat [ptext IF_ARCH_alpha(SLIT("\t.globl\t") ,IF_ARCH_i386(SLIT(".globl ") - ,IF_ARCH_sparc(SLIT("\t.global\t") + ,IF_ARCH_sparc(SLIT(".global\t") ,))) , pp_lab, char '\n'], pp_lab, @@ -432,79 +409,67 @@ pprInstr (ASCII False{-no backslash conversion-} str) = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ] pprInstr (ASCII True str) - = (<>) (text "\t.ascii \"") (asciify str 60) - where - 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:(cs@(d:_))) n - | isDigit d = (<>) (text (charToC c)) (asciify cs 0) - | otherwise = (<>) (text (charToC c)) (asciify cs (n-1)) - #if 0 -pprInstr (DATA s xs) - = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs] + -- The Solaris assembler doesn't understand \x escapes in + -- strings. + = asciify str where - pp_size = case s of -#if alpha_TARGET_ARCH - B -> SLIT("\t.byte\t") - BU -> SLIT("\t.byte\t") - Q -> SLIT("\t.quad\t") - TF -> SLIT("\t.t_floating\t") -#endif -#if i386_TARGET_ARCH - B -> SLIT("\t.byte\t") - L -> SLIT("\t.long\t") - F -> SLIT("\t.float\t") - DF -> SLIT("\t.double\t") -#endif -#if sparc_TARGET_ARCH - B -> SLIT("\t.byte\t") - BU -> SLIT("\t.byte\t") - W -> SLIT("\t.word\t") - DF -> SLIT("\t.double\t") -#endif + asciify :: String -> SDoc + asciify "" = text "\t.ascii \"\\0\"" + asciify str + = let fst = take 16 str + rest = drop 16 str + this = text ("\t.ascii \"" + ++ concat (map asciify_char fst) + ++ "\"") + in this $$ asciify rest + asciify_char :: Char -> String + asciify_char c = '\\' : 'x' : hshow (ord c) #endif + = vcat (map do1 (str ++ [chr 0])) + where + do1 :: Char -> SDoc + do1 c = text "\t.byte\t0x" <> text (hshow (ord c)) + + hshow :: Int -> String + hshow n | n >= 0 && n <= 255 + = [ tab !! (n `div` 16), tab !! (n `mod` 16)] + tab = "0123456789ABCDEF" pprInstr (DATA s xs) = vcat (concatMap (ppr_item s) xs) where + #if alpha_TARGET_ARCH ppr_item = error "ppr_item on Alpha" -#if 0 - This needs to be fixed. - B -> SLIT("\t.byte\t") - BU -> SLIT("\t.byte\t") - Q -> SLIT("\t.quad\t") - TF -> SLIT("\t.t_floating\t") -#endif #endif #if sparc_TARGET_ARCH - ppr_item = error "ppr_item on Sparc" -#if 0 - This needs to be fixed. - B -> SLIT("\t.byte\t") - BU -> SLIT("\t.byte\t") - W -> SLIT("\t.word\t") - DF -> SLIT("\t.double\t") -#endif + -- copy n paste of x86 version + ppr_item B x = [text "\t.byte\t" <> pprImm x] + ppr_item W x = [text "\t.long\t" <> pprImm x] + ppr_item F (ImmFloat r) + = let bs = floatToBytes (fromRational r) + in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs + ppr_item DF (ImmDouble r) + = let bs = doubleToBytes (fromRational r) + in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs #endif #if i386_TARGET_ARCH ppr_item B x = [text "\t.byte\t" <> pprImm x] ppr_item L x = [text "\t.long\t" <> pprImm x] - ppr_item F (ImmDouble r) + ppr_item F (ImmFloat r) = let bs = floatToBytes (fromRational r) in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs ppr_item DF (ImmDouble r) = let bs = doubleToBytes (fromRational r) in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs +#endif + -- floatToBytes and doubleToBytes convert to the host's byte + -- order. Providing that we're not cross-compiling for a + -- target with the opposite endianness, this should work ok + -- on all targets. floatToBytes :: Float -> [Int] floatToBytes f = runST (do @@ -533,8 +498,6 @@ pprInstr (DATA s xs) return (map ord [i0,i1,i2,i3,i4,i5,i6,i7]) ) -#endif - -- fall through to rest of (machine-specific) pprInstr... \end{code} @@ -938,7 +901,7 @@ pprSizeRegRegReg name size reg1 reg2 reg3 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack | src == dst = -#ifdef DEBUG +#if 0 /* #ifdef DEBUG */ (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d) #else empty @@ -996,10 +959,9 @@ pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op) 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) - = (<>) (ptext SLIT("\tcall ")) (pprImm imm) +pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm) +pprInstr (JMP dsts op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op) +pprInstr (CALL imm) = (<>) (ptext SLIT("\tcall ")) (pprImm imm) -- Simulating a flat register set on the x86 FP stack is tricky. @@ -1021,6 +983,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) @@ -1032,55 +999,113 @@ 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 ; ", - gpush src2 0, gsemi, gpush src1 1] + = pprG g (hcat [gtab, text "pushl %eax ; ",gpush src1 0] $$ - hcat [gtab, text "fcompp ; fstsw %ax ; sahf ; popl %eax"]) + hcat [gtab, text "fcomp ", greg src2 1, + text "; fstsw %ax ; sahf ; popl %eax"]) 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 ; ", gpop dst 1]) + = 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 ; ", gpop dst 1]) - + = 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) ; ", gpop dst 1]) + text " fstp %st(0)"] $$ + hcat [gtab, gcoerceto sz, gpop dst 1]) + +-- In the translations for GADD, GMUL, GSUB and GDIV, +-- the first two cases are mere optimisations. The otherwise clause +-- generates correct code under all circumstances. pprInstr g@(GADD sz src1 src2 dst) + | src1 == dst + = pprG g (text "\t#GADD-xxxcase1" $$ + hcat [gtab, gpush src2 0, + text " ; faddp %st(0),", greg src1 1]) + | src2 == dst + = pprG g (text "\t#GADD-xxxcase2" $$ + hcat [gtab, gpush src1 0, + text " ; faddp %st(0),", greg src2 1]) + | otherwise = pprG g (hcat [gtab, gpush src1 0, text " ; fadd ", greg src2 1, text ",%st(0)", gsemi, gpop dst 1]) -pprInstr g@(GSUB sz src1 src2 dst) - = pprG g (hcat [gtab, gpush src1 0, - text " ; fsub ", greg src2 1, text ",%st(0)", - gsemi, gpop dst 1]) + + pprInstr g@(GMUL sz src1 src2 dst) + | src1 == dst + = pprG g (text "\t#GMUL-xxxcase1" $$ + hcat [gtab, gpush src2 0, + text " ; fmulp %st(0),", greg src1 1]) + | src2 == dst + = pprG g (text "\t#GMUL-xxxcase2" $$ + hcat [gtab, gpush src1 0, + text " ; fmulp %st(0),", greg src2 1]) + | otherwise = pprG g (hcat [gtab, gpush src1 0, text " ; fmul ", greg src2 1, text ",%st(0)", gsemi, gpop dst 1]) + + +pprInstr g@(GSUB sz src1 src2 dst) + | src1 == dst + = pprG g (text "\t#GSUB-xxxcase1" $$ + hcat [gtab, gpush src2 0, + text " ; fsubrp %st(0),", greg src1 1]) + | src2 == dst + = pprG g (text "\t#GSUB-xxxcase2" $$ + hcat [gtab, gpush src1 0, + text " ; fsubp %st(0),", greg src2 1]) + | otherwise + = pprG g (hcat [gtab, gpush src1 0, + text " ; fsub ", greg src2 1, text ",%st(0)", + gsemi, gpop dst 1]) + + pprInstr g@(GDIV sz src1 src2 dst) + | src1 == dst + = pprG g (text "\t#GDIV-xxxcase1" $$ + hcat [gtab, gpush src2 0, + text " ; fdivrp %st(0),", greg src1 1]) + | src2 == dst + = pprG g (text "\t#GDIV-xxxcase2" $$ + hcat [gtab, gpush src1 0, + text " ; fdivp %st(0),", greg src2 1]) + | otherwise = 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 @@ -1091,9 +1116,10 @@ greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')' gsemi = text " ; " gtab = char '\t' gsp = char ' ' -gregno (FixedReg i) = I# i -gregno (MappedReg i) = I# i -gregno other = pprPanic "gregno" (text (show other)) + +gregno (RealReg i) = i +gregno other = --pprPanic "gregno" (ppr other) + 999 -- bogus; only needed for debug printing pprG :: Instr -> SDoc -> SDoc pprG fake actual @@ -1103,6 +1129,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 @@ -1130,11 +1159,11 @@ 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 @@ -1196,6 +1225,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 [ @@ -1308,61 +1347,70 @@ pprCondInstr name cond arg -- even clumsier, to allow for RegReg regs that show when doing indexed -- reads (bytearrays). -- + +-- Translate to the following: +-- add g1,g2,g1 +-- ld [g1],%fn +-- ld [g1+4],%f(n+1) +-- sub g1,g2,g1 -- to restore g1 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) + = vcat [ + hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1], + hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg], + hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)], + hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1] ] -pprInstr (LD DF addr reg) | maybeToBool off_addr - = hcat [ - pp_ld_lbracket, - pprAddr addr, - pp_rbracket_comma, - pprReg reg, - - char '\n', - pp_ld_lbracket, - pprAddr addr2, - pp_rbracket_comma, - pprReg (fPair reg) +-- Translate to +-- ld [addr],%fn +-- ld [addr+4],%f(n+1) +pprInstr (LD DF addr reg) | isJust off_addr + = vcat [ + hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg], + hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)] ] where off_addr = addrOffset addr 4 addr2 = case off_addr of Just x -> x + pprInstr (LD size addr reg) = hcat [ - ptext SLIT("\tld"), - pprSize size, - char '\t', - lbrack, - pprAddr addr, - pp_rbracket_comma, - pprReg reg + ptext SLIT("\tld"), + pprSize size, + char '\t', + lbrack, + pprAddr addr, + pp_rbracket_comma, + pprReg reg ] -- The same clumsy hack as above +-- Translate to the following: +-- add g1,g2,g1 +-- st %fn,[g1] +-- st %f(n+1),[g1+4] +-- sub g1,g2,g1 -- to restore g1 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]") + = vcat [ + hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1], + hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket, + pprReg g1, rbrack], + hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket, + pprReg g1, ptext SLIT("+4]")], + hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1] ] -pprInstr (ST DF reg addr) | maybeToBool off_addr - = hcat [ - ptext SLIT("\tst\t"), - pprReg reg, pp_comma_lbracket, pprAddr addr, - - ptext SLIT("]\n\tst\t"), - pprReg (fPair reg), pp_comma_lbracket, - pprAddr addr2, rbrack +-- Translate to +-- st %fn,[addr] +-- st %f(n+1),[addr+4] +pprInstr (ST DF reg addr) | isJust off_addr + = vcat [ + hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket, + pprAddr addr, rbrack], + hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket, + pprAddr addr2, rbrack] ] where off_addr = addrOffset addr 4 @@ -1374,13 +1422,13 @@ pprInstr (ST DF reg addr) | maybeToBool off_addr pprInstr (ST size reg addr) = hcat [ - ptext SLIT("\tst"), - pprStSize size, - char '\t', - pprReg reg, - pp_comma_lbracket, - pprAddr addr, - rbrack + ptext SLIT("\tst"), + pprStSize size, + char '\t', + pprReg reg, + pp_comma_lbracket, + pprAddr addr, + rbrack ] pprInstr (ADD x cc reg1 ri reg2) @@ -1491,7 +1539,7 @@ pprInstr (BF cond b lab) pprImm lab ] -pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr) +pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr) pprInstr (CALL imm n _) = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]