\begin{code}
#include "nativeGen/NCG.h"
-module PprMach ( pprInstr ) 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(..) )
-import Char ( isPrint, isDigit )
import Outputable
+
+import ST
+import MutableArray
+import Char ( chr, ord )
+import Maybe ( isJust )
\end{code}
%************************************************************************
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 -> 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
+ ppr_reg_no :: Int -> SDoc
ppr_reg_no i = ptext
(case i of {
- ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
- ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
- ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
- ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
- ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
- ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
- ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
- ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
- ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
- ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
- ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
- ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
- ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
- ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
- ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
- ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
- ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
- ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
- ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
- ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
- ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
- ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
- ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
- ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
- ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
- ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
- ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
- ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
- ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
- ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
- ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
- ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
- _ -> SLIT("very naughty alpha register")
+ 0 -> SLIT("$0"); 1 -> SLIT("$1");
+ 2 -> SLIT("$2"); 3 -> SLIT("$3");
+ 4 -> SLIT("$4"); 5 -> SLIT("$5");
+ 6 -> SLIT("$6"); 7 -> SLIT("$7");
+ 8 -> SLIT("$8"); 9 -> SLIT("$9");
+ 10 -> SLIT("$10"); 11 -> SLIT("$11");
+ 12 -> SLIT("$12"); 13 -> SLIT("$13");
+ 14 -> SLIT("$14"); 15 -> SLIT("$15");
+ 16 -> SLIT("$16"); 17 -> SLIT("$17");
+ 18 -> SLIT("$18"); 19 -> SLIT("$19");
+ 20 -> SLIT("$20"); 21 -> SLIT("$21");
+ 22 -> SLIT("$22"); 23 -> SLIT("$23");
+ 24 -> SLIT("$24"); 25 -> SLIT("$25");
+ 26 -> SLIT("$26"); 27 -> SLIT("$27");
+ 28 -> SLIT("$28"); 29 -> SLIT("$29");
+ 30 -> SLIT("$30"); 31 -> SLIT("$31");
+ 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
+ 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
+ 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
+ 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
+ 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
+ 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
+ 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
+ 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
+ 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
+ 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
+ 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
+ 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
+ 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
+ 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
+ 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
+ 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
+ _ -> SLIT("very naughty alpha register")
})
#endif
#if i386_TARGET_ARCH
- 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");
- 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
+ ppr_reg_no :: Size -> Int -> SDoc
+ ppr_reg_no B 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")
+ 0 -> SLIT("%al"); 1 -> SLIT("%bl");
+ 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
+ _ -> SLIT("very naughty I386 byte 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 {
- --ToDo: rm these (???)
- ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
- ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
- ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
- ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
- _ -> SLIT("very naughty I386 float register")
- })
-
- ppr_reg_no DF i = ptext
- (case i of {
- --ToDo: rm these (???)
- ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
- ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
- ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
- ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
- _ -> SLIT("very naughty I386 float register")
+ 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
+ 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
+ 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
+ 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
+ 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
+ 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
+ 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
+ _ -> SLIT("very naughty I386 register")
})
#endif
#if sparc_TARGET_ARCH
- ppr_reg_no :: FAST_REG_NO -> SDoc
+ ppr_reg_no :: Int -> SDoc
ppr_reg_no i = ptext
(case i of {
- ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
- ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
- ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
- ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
- ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
- ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
- ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
- ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
- ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
- ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
- ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
- ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
- ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
- ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
- ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
- ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
- ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
- ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
- ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
- ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
- ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
- ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
- ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
- ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
- ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
- ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
- ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
- ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
- ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
- ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
- ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
- ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
- _ -> SLIT("very naughty sparc register")
+ 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
+ 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
+ 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
+ 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
+ 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
+ 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
+ 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
+ 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
+ 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
+ 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
+ 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
+ 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
+ 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
+ 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
+ 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
+ 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
+ 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
+ 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
+ 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
+ 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
+ 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
+ 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
+ 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
+ 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
+ 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
+ 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
+ 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
+ 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
+ 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
+ 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
+ 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
+ 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
+ _ -> SLIT("very naughty sparc register")
})
#endif
\end{code}
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
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")
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)
#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 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 ]
\begin{code}
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)
---sparc: = (<>) (ptext SLIT("! ")) (ptext s)
+--pprInstr (COMMENT s) = empty -- nuke 'em
+pprInstr (COMMENT s)
+ = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ptext s))
+ ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ptext s))
+ ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ptext s))
+ ,)))
-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((_PK_ ".text\n\t.align 4") {-needs per-OS variation!-}
- ,)))
+pprInstr (DELTA d)
+ = pprInstr (COMMENT (_PK_ ("\tdelta = " ++ show d)))
-#if 0
- ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-}
-#endif
+pprInstr (SEGMENT TextSegment)
+ = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-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")
,)))
-#if 0
- ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
-#endif
-
pprInstr (LABEL clab)
= let
pp_lab = pprCLabel_asm 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,
= hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
pprInstr (ASCII True str)
- = (<>) (text "\t.ascii \"") (asciify str 60)
+#if 0
+ -- The Solaris assembler doesn't understand \x escapes in
+ -- strings.
+ = asciify str
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))
+ 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 [(<>) (ptext pp_size) (pprImm x) | x <- xs]
- where
- pp_size = case s of
+ = vcat (concatMap (ppr_item s) xs)
+ where
+
#if alpha_TARGET_ARCH
- B -> SLIT("\t.byte\t")
- BU -> SLIT("\t.byte\t")
---UNUSED: W -> SLIT("\t.word\t")
---UNUSED: WU -> SLIT("\t.word\t")
---UNUSED: L -> SLIT("\t.long\t")
- Q -> SLIT("\t.quad\t")
---UNUSED: FF -> SLIT("\t.f_floating\t")
---UNUSED: DF -> SLIT("\t.d_floating\t")
---UNUSED: GF -> SLIT("\t.g_floating\t")
---UNUSED: SF -> SLIT("\t.s_floating\t")
- TF -> SLIT("\t.t_floating\t")
-#endif
-#if i386_TARGET_ARCH
- B -> SLIT("\t.byte\t")
---UNUSED: HB -> SLIT("\t.byte\t")
---UNUSED: S -> SLIT("\t.word\t")
- L -> SLIT("\t.long\t")
- F -> SLIT("\t.float\t")
- DF -> SLIT("\t.double\t")
+ ppr_item = error "ppr_item on Alpha"
#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")
+ -- 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 (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
+ arr <- newFloatArray ((0::Int),3)
+ writeFloatArray arr 0 f
+ i0 <- readCharArray arr 0
+ i1 <- readCharArray arr 1
+ i2 <- readCharArray arr 2
+ i3 <- readCharArray arr 3
+ return (map ord [i0,i1,i2,i3])
+ )
+
+ doubleToBytes :: Double -> [Int]
+ doubleToBytes d
+ = runST (do
+ arr <- newDoubleArray ((0::Int),7)
+ writeDoubleArray arr 0 d
+ i0 <- readCharArray arr 0
+ i1 <- readCharArray arr 1
+ i2 <- readCharArray arr 2
+ i3 <- readCharArray arr 3
+ i4 <- readCharArray arr 4
+ i5 <- readCharArray arr 5
+ i6 <- readCharArray arr 6
+ i7 <- readCharArray arr 7
+ return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
+ )
+
-- fall through to rest of (machine-specific) pprInstr...
\end{code}
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
- (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 (PUSH size op) = pprSizeOp SLIT("push") size op
pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
+pprInstr PUSHA = ptext SLIT("\tpushal")
+pprInstr POPA = ptext SLIT("\tpopal")
pprInstr (NOP) = ptext SLIT("\tnop")
pprInstr (CLTD) = ptext SLIT("\tcltd")
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)
- = hcat [ ptext SLIT("\tcall "), pprImm imm ]
-
-pprInstr SAHF = ptext SLIT("\tsahf")
-pprInstr FABS = ptext SLIT("\tfabs")
-
-pprInstr (FADD sz src@(OpAddr _))
- = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
-pprInstr (FADD sz src)
- = ptext SLIT("\tfadd")
-pprInstr FADDP
- = ptext SLIT("\tfaddp")
-pprInstr (FMUL sz src)
- = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
-pprInstr FMULP
- = ptext SLIT("\tfmulp")
-pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
-pprInstr FCHS = ptext SLIT("\tfchs")
-pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
-pprInstr FCOS = ptext SLIT("\tfcos")
-pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
-pprInstr (FDIV sz src)
- = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
-pprInstr FDIVP
- = ptext SLIT("\tfdivp")
-pprInstr (FDIVR sz src)
- = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
-pprInstr FDIVRP
- = ptext SLIT("\tfdivpr")
-pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
-pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
-pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
-pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
-pprInstr (FLD sz (OpImm (ImmCLbl src)))
- = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
-pprInstr (FLD sz src)
- = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
-pprInstr FLD1 = ptext SLIT("\tfld1")
-pprInstr FLDZ = ptext SLIT("\tfldz")
-pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
-pprInstr FRNDINT = ptext SLIT("\tfrndint")
-pprInstr FSIN = ptext SLIT("\tfsin")
-pprInstr FSQRT = ptext SLIT("\tfsqrt")
-pprInstr (FST sz dst)
- = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
-pprInstr (FSTP sz dst)
- = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
-pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
-pprInstr (FSUB sz src)
- = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
-pprInstr FSUBP
- = ptext SLIT("\tfsubp")
-pprInstr (FSUBR size src)
- = pprSizeOp SLIT("fsubr") size src
-pprInstr FSUBRP
- = ptext SLIT("\tfsubpr")
-pprInstr (FISUBR size op)
- = pprSizeAddr SLIT("fisubr") size op
-pprInstr FTST = ptext SLIT("\tftst")
-pprInstr (FCOMP sz op)
- = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
-pprInstr FUCOMPP = ptext SLIT("\tfucompp")
-pprInstr FXCH = ptext SLIT("\tfxch")
-pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
-pprInstr FNOP = ptext SLIT("")
+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.
+-- you have to free %st(7) before pushing anything on the FP reg stack
+-- so as to preclude the possibility of a FP stack overflow exception.
+pprInstr g@(GMOV src dst)
+ | src == dst
+ = empty
+ | otherwise
+ = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
+
+-- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
+pprInstr g@(GLD sz addr dst)
+ = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
+ pprAddr addr, gsemi, gpop dst 1])
+
+-- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
+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)
+ = pprG g bogus
+
+pprInstr g@(GDTOF src dst)
+ = pprG g bogus
+pprInstr g@(GDTOI src dst)
+ = pprG g bogus
+
+pprInstr g@(GITOF src dst)
+ = pprInstr (GITOD src dst)
+pprInstr g@(GITOD src dst)
+ = 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 src1 0]
+ $$
+ 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"] $$
+ 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])
+
+-- 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@(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
+ = hcat [text "fstp ", greg reg offset]
+
+bogus = text "\tbogus"
+greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
+gsemi = text " ; "
+gtab = char '\t'
+gsp = char ' '
+
+gregno (RealReg i) = i
+gregno other = --pprPanic "gregno" (ppr other)
+ 999 -- bogus; only needed for debug printing
+
+pprG :: Instr -> SDoc -> SDoc
+pprG fake actual
+ = (char '#' <> pprGInstr fake) $$ actual
+
+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
+
+pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
+pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
+
+pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
+pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
+
+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
+pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
+pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
\end{code}
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 [
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 [
+ char '\t',
+ ptext name,
+ pprSize size,
+ space,
+ pprReg size reg1,
+ comma,
+ pprReg size reg2
+ ]
+
+pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
+pprSizeSizeRegReg name size1 size2 reg1 reg2
+ = hcat [
+ char '\t',
+ ptext name,
+ pprSize size1,
+ pprSize size2,
+ space,
+ pprReg size1 reg1,
+ comma,
+ pprReg size2 reg2
+ ]
+
+pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
+pprSizeRegRegReg name size reg1 reg2 reg3
+ = hcat [
+ char '\t',
+ ptext name,
+ pprSize size,
+ space,
+ pprReg size reg1,
+ comma,
+ pprReg size reg2,
+ comma,
+ pprReg size reg3
+ ]
+
pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
pprSizeAddr name size op
= hcat [
pprReg size dst
]
+pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
+pprSizeRegAddr name size src op
+ = hcat [
+ char '\t',
+ ptext name,
+ pprSize size,
+ space,
+ pprReg size src,
+ comma,
+ pprAddr op
+ ]
+
pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
pprOpOp name size op1 op2
= 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
-- 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
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)
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 ]