import MachRegs -- may differ per-platform
import MachMisc
-import CLabel ( pprCLabel_asm, externallyVisibleCLabel, labelDynamic )
-import CStrings ( charToC )
-import Maybes ( maybeToBool )
-import Stix ( CodeSegment(..), StixTree(..) )
-import Char ( isPrint, isDigit )
-import Outputable
+import CLabel ( pprCLabel, externallyVisibleCLabel, labelDynamic )
+import Stix ( CodeSegment(..) )
+import Unique ( pprUnique )
+import Panic ( panic )
+import Pretty
+import qualified Outputable
import ST
import MutableArray
-import Char ( ord )
+import Char ( chr, ord )
+import Maybe ( isJust )
+
+asmSDoc d = Outputable.withPprStyleDoc (
+ Outputable.mkCodeStyle Outputable.AsmStyle) d
+pprCLabel_asm l = asmSDoc (pprCLabel l)
\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 :: Reg -> Doc
pprUserReg = pprReg IF_ARCH_i386(L,)
-
-pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc
+pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc
pprReg IF_ARCH_i386(s,) r
= case r of
- RealReg (I# i) -> ppr_reg_no IF_ARCH_i386(s,) i
- VirtualRegI u -> text "%vI_" <> ppr u
- VirtualRegF u -> text "%vF_" <> ppr u
+ RealReg i -> ppr_reg_no IF_ARCH_i386(s,) i
+ VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
+ VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
where
#if alpha_TARGET_ARCH
- ppr_reg_no :: FAST_REG_NO -> SDoc
+ ppr_reg_no :: Int -> Doc
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
+ ppr_reg_no :: Size -> Int -> Doc
+ ppr_reg_no B = ppr_reg_byte
+ ppr_reg_no Bu = ppr_reg_byte
+ ppr_reg_no W = ppr_reg_word
+ ppr_reg_no Wu = ppr_reg_word
+ ppr_reg_no _ = ppr_reg_long
+
+ ppr_reg_byte i = ptext
+ (case i of {
+ 0 -> SLIT("%al"); 1 -> SLIT("%bl");
+ 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
+ _ -> SLIT("very naughty I386 byte register")
+ })
+
+ ppr_reg_word 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")
+ 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
+ 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
+ 4 -> SLIT("%si"); 5 -> SLIT("%di");
+ 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
+ _ -> SLIT("very naughty I386 word register")
})
- ppr_reg_no _ i = ptext
+ ppr_reg_long 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");
- 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 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 -> Doc
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}
%************************************************************************
\begin{code}
-pprSize :: Size -> SDoc
+pprSize :: Size -> Doc
pprSize x = ptext (case x of
#if alpha_TARGET_ARCH
B -> SLIT("b")
- BU -> SLIT("bu")
+ Bu -> SLIT("bu")
-- W -> SLIT("w") UNUSED
--- WU -> SLIT("wu") UNUSED
--- L -> SLIT("l") UNUSED
+-- Wu -> SLIT("wu") UNUSED
+ L -> SLIT("l")
Q -> SLIT("q")
-- FF -> SLIT("f") UNUSED
-- DF -> SLIT("d") UNUSED
#endif
#if i386_TARGET_ARCH
B -> SLIT("b")
--- HB -> SLIT("b") UNUSED
--- S -> SLIT("w") UNUSED
+ Bu -> SLIT("b")
+ W -> SLIT("w")
+ Wu -> SLIT("w")
L -> SLIT("l")
+ Lu -> SLIT("l")
F -> SLIT("s")
DF -> SLIT("l")
F80 -> SLIT("t")
#endif
#if sparc_TARGET_ARCH
B -> SLIT("sb")
- BU -> SLIT("ub")
--- HW -> SLIT("hw") UNUSED
--- HWU -> SLIT("uhw") UNUSED
+ Bu -> SLIT("ub")
W -> SLIT("")
F -> SLIT("")
--- D -> SLIT("d") UNUSED
DF -> SLIT("d")
)
-pprStSize :: Size -> SDoc
+pprStSize :: Size -> Doc
pprStSize x = ptext (case x of
B -> SLIT("b")
- BU -> SLIT("b")
--- HW -> SLIT("hw") UNUSED
--- HWU -> SLIT("uhw") UNUSED
+ Bu -> SLIT("b")
W -> SLIT("")
F -> SLIT("")
--- D -> SLIT("d") UNUSED
DF -> SLIT("d")
#endif
)
%************************************************************************
\begin{code}
-pprCond :: Cond -> SDoc
+pprCond :: Cond -> Doc
pprCond c = ptext (case c of {
#if alpha_TARGET_ARCH
%************************************************************************
\begin{code}
-pprImm :: Imm -> SDoc
+pprImm :: Imm -> Doc
pprImm (ImmInt i) = int i
pprImm (ImmInteger i) = integer i
%************************************************************************
\begin{code}
-pprAddr :: MachRegsAddr -> SDoc
+pprAddr :: MachRegsAddr -> Doc
#if alpha_TARGET_ARCH
pprAddr (AddrReg r) = parens (pprReg r)
%************************************************************************
\begin{code}
-pprInstr :: Instr -> SDoc
+pprInstr :: Instr -> Doc
--pprInstr (COMMENT s) = empty -- nuke 'em
pprInstr (COMMENT s)
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")
,)))
+pprInstr (SEGMENT RoDataSegment)
+ = ptext
+ IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
+ ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
+ ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
+ ,)))
+
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)
- = asciify str
- where
- 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)
-
- hshow :: Int -> String
- hshow n | n >= 0 && n <= 255
- = [ tab !! (n `div` 16), tab !! (n `mod` 16)]
- tab = "0123456789abcdef"
+ = vcat (map do1 (str ++ [chr 0]))
+ where
+ do1 :: Char -> Doc
+ do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
+ hshow :: Int -> Doc
+ hshow n | n >= 0 && n <= 255
+ = char (tab !! (n `div` 16)) <> char (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 = [ptext SLIT("\t.byte\t") <> pprImm x]
+ ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x]
+ ppr_item F (ImmFloat r)
+ = let bs = floatToBytes (fromRational r)
+ in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
+ ppr_item DF (ImmDouble r)
+ = let bs = doubleToBytes (fromRational r)
+ in map (\b -> ptext SLIT("\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 B x = [ptext SLIT("\t.byte\t") <> pprImm x]
+ ppr_item L x = [ptext SLIT("\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
+ in map (\b -> ptext SLIT("\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
+ in map (\b -> ptext SLIT("\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
return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
)
-#endif
-
-- fall through to rest of (machine-specific) pprInstr...
\end{code}
Continue with Alpha-only printing bits and bobs:
\begin{code}
-pprRI :: RI -> SDoc
+pprRI :: RI -> Doc
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r
-pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
+pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Doc
pprRegRIReg name reg1 ri reg2
= hcat [
pprReg reg2
]
-pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
+pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
= pprSizeOpOp SLIT("add") size src dst
pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
-pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
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)
+pprInstr (IQUOT sz src dst) = pprInstr_quotRem True sz src dst
+pprInstr (IREM sz src dst) = pprInstr_quotRem False sz src dst
-- 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
ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
]
+
+pprInstr_quotRem isQuot sz src dst
+ | case sz of L -> False; _ -> True
+ = panic "pprInstr_quotRem: dunno how to do non-32bit operands"
+ | otherwise
+ = vcat [
+ (text "\t# BEGIN " <> fakeInsn),
+ (text "\tpushl $0; pushl %eax; pushl %edx; pushl " <> pprOperand sz src),
+ (text "\tmovl " <> pprOperand sz dst <> text ",%eax; xorl %edx,%edx; cltd"),
+ (text "\tdivl 0(%esp); movl " <> text resReg <> text ",12(%esp)"),
+ (text "\tpopl %edx; popl %edx; popl %eax; popl " <> pprOperand sz dst),
+ (text "\t# END " <> fakeInsn)
+ ]
+ where
+ resReg = if isQuot then "%eax" else "%edx"
+ opStr = if isQuot then "IQUOT" else "IREM"
+ fakeInsn = text opStr <+> pprOperand sz src <> char ',' <+> pprOperand sz dst
+
--------------------------
-- coerce %st(0) to the specified size
gregno other = --pprPanic "gregno" (ppr other)
999 -- bogus; only needed for debug printing
-pprG :: Instr -> SDoc -> SDoc
+pprG :: Instr -> Doc -> Doc
pprG fake actual
= (char '#' <> pprGInstr fake) $$ actual
Continue with I386-only printing bits and bobs:
\begin{code}
-pprDollImm :: Imm -> SDoc
+pprDollImm :: Imm -> Doc
pprDollImm i = ptext SLIT("$") <> pprImm i
-pprOperand :: Size -> Operand -> SDoc
+pprOperand :: Size -> Operand -> Doc
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 :: FAST_STRING -> Size -> Imm -> Operand -> Doc
pprSizeImmOp name size imm op1
= hcat [
char '\t',
pprOperand size op1
]
-pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
+pprSizeOp :: FAST_STRING -> Size -> Operand -> Doc
pprSizeOp name size op1
= hcat [
char '\t',
pprOperand size op1
]
-pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
+pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
pprSizeOpOp name size op1 op2
= hcat [
char '\t',
pprOperand size op2
]
-pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
+pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
pprSizeByteOpOp name size op1 op2
= hcat [
char '\t',
pprOperand size op2
]
-pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
+pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc
pprSizeOpReg name size op1 reg
= hcat [
char '\t',
pprReg size reg
]
-pprSizeReg :: FAST_STRING -> Size -> Reg -> SDoc
+pprSizeReg :: FAST_STRING -> Size -> Reg -> Doc
pprSizeReg name size reg1
= hcat [
char '\t',
pprReg size reg1
]
-pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
+pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
pprSizeRegReg name size reg1 reg2
= hcat [
char '\t',
pprReg size reg2
]
-pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
+pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> Doc
pprSizeSizeRegReg name size1 size2 reg1 reg2
= hcat [
char '\t',
pprReg size2 reg2
]
-pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
+pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
char '\t',
pprReg size reg3
]
-pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
+pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> Doc
pprSizeAddr name size op
= hcat [
char '\t',
pprAddr op
]
-pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
+pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> Doc
pprSizeAddrReg name size op dst
= hcat [
char '\t',
pprReg size dst
]
-pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
+pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> Doc
pprSizeRegAddr name size src op
= hcat [
char '\t',
pprAddr op
]
-pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
+pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
pprOpOp name size op1 op2
= hcat [
char '\t',
pprOperand size op2
]
-pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
+pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc
pprSizeOpOpCoerce name size1 size2 op1 op2
= hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
pprOperand size1 op1,
pprOperand size2 op2
]
-pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
+pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc
pprCondInstr name cond arg
= hcat [ char '\t', ptext name, pprCond cond, space, arg]
-- 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 ]
Continue with SPARC-only printing bits and bobs:
\begin{code}
--- Get rid of this fPair nonsense, don't reimplement it. It's an
--- entirely unnecessary complication. I just put this here so it will
--- at least compile on Sparcs. JRS, 000616.
-fPair = error "nativeGen(sparc): unimp fPair"
-
-pprRI :: RI -> SDoc
+pprRI :: RI -> Doc
pprRI (RIReg r) = pprReg r
pprRI (RIImm r) = pprImm r
-pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
+pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
pprSizeRegReg name size reg1 reg2
= hcat [
char '\t',
pprReg reg2
]
-pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
+pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
pprSizeRegRegReg name size reg1 reg2 reg3
= hcat [
char '\t',
pprReg reg3
]
-pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
+pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc
pprRegRIReg name b reg1 ri reg2
= hcat [
char '\t',
pprReg reg2
]
-pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
+pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc
pprRIReg name b ri reg1
= hcat [
char '\t',