2 % (c) The AQUA Project, Glasgow University, 1996
4 \section[PprMach]{Pretty-printing assembly language}
6 We start with the @pprXXX@s with some cross-platform commonality
7 (e.g., @pprReg@); we conclude with the no-commonality monster,
11 #include "HsVersions.h"
12 #include "nativeGen/NCG.h"
14 module PprMach ( pprInstr ) where
16 IMPORT_1_3(Char(isPrint,isDigit))
17 #if __GLASGOW_HASKELL__ == 201
18 import qualified GHCbase(Addr(..)) -- to see innards
24 import MachRegs -- may differ per-platform
27 import AbsCSyn ( MagicId )
28 import CLabel ( pprCLabel_asm, externallyVisibleCLabel )
29 import CStrings ( charToC )
30 import Maybes ( maybeToBool )
31 import OrdList ( OrdList )
32 import Stix ( CodeSegment(..), StixTree )
33 import Pretty -- all of it
35 #if __GLASGOW_HASKELL__ == 201
36 a_HASH x = GHCbase.A# x
37 pACK_STR x = packCString x
40 pACK_STR x = mkFastCharString x --_packCString x
44 %************************************************************************
46 \subsection{@pprReg@: print a @Reg@}
48 %************************************************************************
50 For x86, the way we print a register name depends
51 on which bit of it we care about. Yurgh.
53 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc
55 pprReg IF_ARCH_i386(s,) r
57 FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
58 MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
59 other -> text (show other) -- should only happen when debugging
62 ppr_reg_no :: FAST_REG_NO -> Doc
65 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
66 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
67 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
68 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
69 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
70 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
71 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
72 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
73 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
74 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
75 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
76 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
77 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
78 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
79 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
80 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
81 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
82 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
83 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
84 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
85 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
86 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
87 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
88 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
89 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
90 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
91 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
92 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
93 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
94 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
95 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
96 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
97 _ -> SLIT("very naughty alpha register")
101 ppr_reg_no :: Size -> FAST_REG_NO -> Doc
102 ppr_reg_no B i = ptext
104 ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl");
105 ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl");
106 _ -> SLIT("very naughty I386 byte register")
110 ppr_reg_no HB i = ptext
112 ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh");
113 ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh");
114 _ -> SLIT("very naughty I386 high byte register")
119 ppr_reg_no S i = ptext
121 ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx");
122 ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx");
123 ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
124 ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
125 _ -> SLIT("very naughty I386 word register")
129 ppr_reg_no L i = ptext
131 ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
132 ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
133 ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
134 ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
135 _ -> SLIT("very naughty I386 double word register")
138 ppr_reg_no F i = ptext
140 --ToDo: rm these (???)
141 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
142 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
143 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
144 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
145 _ -> SLIT("very naughty I386 float register")
148 ppr_reg_no DF i = ptext
150 --ToDo: rm these (???)
151 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
152 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
153 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
154 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
155 _ -> SLIT("very naughty I386 float register")
158 #if sparc_TARGET_ARCH
159 ppr_reg_no :: FAST_REG_NO -> Doc
162 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
163 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
164 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
165 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
166 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
167 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
168 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
169 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
170 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
171 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
172 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
173 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
174 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
175 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
176 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
177 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
178 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
179 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
180 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
181 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
182 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
183 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
184 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
185 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
186 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
187 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
188 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
189 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
190 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
191 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
192 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
193 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
194 _ -> SLIT("very naughty sparc register")
199 %************************************************************************
201 \subsection{@pprSize@: print a @Size@}
203 %************************************************************************
206 pprSize :: Size -> Doc
208 pprSize x = ptext (case x of
209 #if alpha_TARGET_ARCH
212 -- W -> SLIT("w") UNUSED
213 -- WU -> SLIT("wu") UNUSED
214 -- L -> SLIT("l") UNUSED
216 -- FF -> SLIT("f") UNUSED
217 -- DF -> SLIT("d") UNUSED
218 -- GF -> SLIT("g") UNUSED
219 -- SF -> SLIT("s") UNUSED
224 -- HB -> SLIT("b") UNUSED
225 -- S -> SLIT("w") UNUSED
230 #if sparc_TARGET_ARCH
233 -- HW -> SLIT("hw") UNUSED
234 -- HWU -> SLIT("uhw") UNUSED
237 -- D -> SLIT("d") UNUSED
240 pprStSize :: Size -> Doc
241 pprStSize x = ptext (case x of
244 -- HW -> SLIT("hw") UNUSED
245 -- HWU -> SLIT("uhw") UNUSED
248 -- D -> SLIT("d") UNUSED
254 %************************************************************************
256 \subsection{@pprCond@: print a @Cond@}
258 %************************************************************************
261 pprCond :: Cond -> Doc
263 pprCond c = ptext (case c of {
264 #if alpha_TARGET_ARCH
275 GEU -> SLIT("ae"); LU -> SLIT("b");
276 EQQ -> SLIT("e"); GTT -> SLIT("g");
277 GE -> SLIT("ge"); GU -> SLIT("a");
278 LTT -> SLIT("l"); LE -> SLIT("le");
279 LEU -> SLIT("be"); NE -> SLIT("ne");
280 NEG -> SLIT("s"); POS -> SLIT("ns");
281 ALWAYS -> SLIT("mp") -- hack
283 #if sparc_TARGET_ARCH
284 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
285 GEU -> SLIT("geu"); LU -> SLIT("lu");
286 EQQ -> SLIT("e"); GTT -> SLIT("g");
287 GE -> SLIT("ge"); GU -> SLIT("gu");
288 LTT -> SLIT("l"); LE -> SLIT("le");
289 LEU -> SLIT("leu"); NE -> SLIT("ne");
290 NEG -> SLIT("neg"); POS -> SLIT("pos");
291 VC -> SLIT("vc"); VS -> SLIT("vs")
296 %************************************************************************
298 \subsection{@pprImm@: print an @Imm@}
300 %************************************************************************
305 pprImm (ImmInt i) = int i
306 pprImm (ImmInteger i) = integer i
307 pprImm (ImmCLbl l) = pprCLabel_asm l
308 pprImm (ImmLit s) = s
310 pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s
313 #if sparc_TARGET_ARCH
315 = hcat [ pp_lo, pprImm i, rparen ]
317 pp_lo = ptext (pACK_STR (a_HASH "%lo("#))
320 = hcat [ pp_hi, pprImm i, rparen ]
322 pp_hi = ptext (pACK_STR (a_HASH "%hi("#))
326 %************************************************************************
328 \subsection{@pprAddr@: print an @Addr@}
330 %************************************************************************
333 pprAddr :: Address -> Doc
335 #if alpha_TARGET_ARCH
336 pprAddr (AddrReg r) = parens (pprReg r)
337 pprAddr (AddrImm i) = pprImm i
338 pprAddr (AddrRegImm r1 i)
339 = (<>) (pprImm i) (parens (pprReg r1))
345 pprAddr (ImmAddr imm off)
351 else if (off < 0) then
352 (<>) pp_imm (int off)
354 hcat [pp_imm, char '+', int off]
356 pprAddr (Address base index displacement)
358 pp_disp = ppr_disp displacement
359 pp_off p = (<>) pp_disp (parens p)
360 pp_reg r = pprReg L r
363 (Nothing, Nothing) -> pp_disp
364 (Just b, Nothing) -> pp_off (pp_reg b)
365 (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i])
366 (Just b, Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i])
368 ppr_disp (ImmInt 0) = empty
369 ppr_disp imm = pprImm imm
374 #if sparc_TARGET_ARCH
375 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
377 pprAddr (AddrRegReg r1 r2)
378 = hcat [ pprReg r1, char '+', pprReg r2 ]
380 pprAddr (AddrRegImm r1 (ImmInt i))
382 | not (fits13Bits i) = largeOffsetError i
383 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
385 pp_sign = if i > 0 then char '+' else empty
387 pprAddr (AddrRegImm r1 (ImmInteger i))
389 | not (fits13Bits i) = largeOffsetError i
390 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
392 pp_sign = if i > 0 then char '+' else empty
394 pprAddr (AddrRegImm r1 imm)
395 = hcat [ pprReg r1, char '+', pprImm imm ]
399 %************************************************************************
401 \subsection{@pprInstr@: print an @Instr@}
403 %************************************************************************
406 pprInstr :: Instr -> Doc
408 --pprInstr (COMMENT s) = (<>) (ptext SLIT("# ")) (ptext s)
409 pprInstr (COMMENT s) = empty -- nuke 'em
410 --alpha: = (<>) (ptext SLIT("\t# ")) (ptext s)
411 --i386 : = (<>) (ptext SLIT("# ")) (ptext s)
412 --sparc: = (<>) (ptext SLIT("! ")) (ptext s)
414 pprInstr (SEGMENT TextSegment)
416 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
417 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
418 ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-}
421 pprInstr (SEGMENT DataSegment)
423 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
424 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
425 ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
428 pprInstr (LABEL clab)
430 pp_lab = pprCLabel_asm clab
433 if not (externallyVisibleCLabel clab) then
437 IF_ARCH_alpha(SLIT("\t.globl\t")
438 ,IF_ARCH_i386(SLIT(".globl ")
439 ,IF_ARCH_sparc(SLIT("\t.global\t")
441 , pp_lab, char '\n'],
446 pprInstr (ASCII False{-no backslash conversion-} str)
447 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
449 pprInstr (ASCII True str)
450 = (<>) (text "\t.ascii \"") (asciify str 60)
452 asciify :: String -> Int -> Doc
454 asciify [] _ = text "\\0\""
455 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
456 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
457 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
458 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
459 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\""))
460 asciify (c:(cs@(d:_))) n
461 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
462 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
465 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
468 #if alpha_TARGET_ARCH
469 B -> SLIT("\t.byte\t")
470 BU -> SLIT("\t.byte\t")
471 --UNUSED: W -> SLIT("\t.word\t")
472 --UNUSED: WU -> SLIT("\t.word\t")
473 --UNUSED: L -> SLIT("\t.long\t")
474 Q -> SLIT("\t.quad\t")
475 --UNUSED: FF -> SLIT("\t.f_floating\t")
476 --UNUSED: DF -> SLIT("\t.d_floating\t")
477 --UNUSED: GF -> SLIT("\t.g_floating\t")
478 --UNUSED: SF -> SLIT("\t.s_floating\t")
479 TF -> SLIT("\t.t_floating\t")
482 B -> SLIT("\t.byte\t")
483 --UNUSED: HB -> SLIT("\t.byte\t")
484 --UNUSED: S -> SLIT("\t.word\t")
485 L -> SLIT("\t.long\t")
486 F -> SLIT("\t.long\t")
487 DF -> SLIT("\t.double\t")
489 #if sparc_TARGET_ARCH
490 B -> SLIT("\t.byte\t")
491 BU -> SLIT("\t.byte\t")
492 W -> SLIT("\t.word\t")
493 DF -> SLIT("\t.double\t")
496 -- fall through to rest of (machine-specific) pprInstr...
499 %************************************************************************
501 \subsubsection{@pprInstr@ for an Alpha}
503 %************************************************************************
506 #if alpha_TARGET_ARCH
508 pprInstr (LD size reg addr)
518 pprInstr (LDA reg addr)
520 ptext SLIT("\tlda\t"),
526 pprInstr (LDAH reg addr)
528 ptext SLIT("\tldah\t"),
534 pprInstr (LDGP reg addr)
536 ptext SLIT("\tldgp\t"),
542 pprInstr (LDI size reg imm)
552 pprInstr (ST size reg addr)
564 ptext SLIT("\tclr\t"),
568 pprInstr (ABS size ri reg)
578 pprInstr (NEG size ov ri reg)
582 if ov then ptext SLIT("v\t") else char '\t',
588 pprInstr (ADD size ov reg1 ri reg2)
592 if ov then ptext SLIT("v\t") else char '\t',
600 pprInstr (SADD size scale reg1 ri reg2)
602 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
613 pprInstr (SUB size ov reg1 ri reg2)
617 if ov then ptext SLIT("v\t") else char '\t',
625 pprInstr (SSUB size scale reg1 ri reg2)
627 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
638 pprInstr (MUL size ov reg1 ri reg2)
642 if ov then ptext SLIT("v\t") else char '\t',
650 pprInstr (DIV size uns reg1 ri reg2)
654 if uns then ptext SLIT("u\t") else char '\t',
662 pprInstr (REM size uns reg1 ri reg2)
666 if uns then ptext SLIT("u\t") else char '\t',
674 pprInstr (NOT ri reg)
683 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
684 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
685 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
686 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
687 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
688 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
690 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
691 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
692 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
694 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
695 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
697 pprInstr (NOP) = ptext SLIT("\tnop")
699 pprInstr (CMP cond reg1 ri reg2)
713 ptext SLIT("\tfclr\t"),
717 pprInstr (FABS reg1 reg2)
719 ptext SLIT("\tfabs\t"),
725 pprInstr (FNEG size reg1 reg2)
735 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
736 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
737 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
738 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
740 pprInstr (CVTxy size1 size2 reg1 reg2)
744 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
751 pprInstr (FCMP size cond reg1 reg2 reg3)
764 pprInstr (FMOV reg1 reg2)
766 ptext SLIT("\tfmov\t"),
772 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
774 pprInstr (BI NEVER reg lab) = empty
776 pprInstr (BI cond reg lab)
786 pprInstr (BF cond reg lab)
797 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
799 pprInstr (JMP reg addr hint)
801 ptext SLIT("\tjmp\t"),
810 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
812 pprInstr (JSR reg addr n)
814 ptext SLIT("\tjsr\t"),
820 pprInstr (FUNBEGIN clab)
822 if (externallyVisibleCLabel clab) then
823 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
826 ptext SLIT("\t.ent "),
835 pp_lab = pprCLabel_asm clab
837 pp_ldgp = ptext (pACK_STR (a_HASH ":\n\tldgp $29,0($27)\n"#))
838 pp_frame = ptext (pACK_STR (a_HASH "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#))
840 pprInstr (FUNEND clab)
841 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
844 Continue with Alpha-only printing bits and bobs:
848 pprRI (RIReg r) = pprReg r
849 pprRI (RIImm r) = pprImm r
851 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Doc
853 pprRegRIReg name reg1 ri reg2
865 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
867 pprSizeRegRegReg name size reg1 reg2 reg3
880 #endif {-alpha_TARGET_ARCH-}
883 %************************************************************************
885 \subsubsection{@pprInstr@ for an I386}
887 %************************************************************************
892 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
896 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
900 pprInstr (MOV size src dst)
901 = pprSizeOpOp SLIT("mov") size src dst
902 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
903 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
905 -- here we do some patching, since the physical registers are only set late
906 -- in the code generation.
907 pprInstr (LEA size (OpAddr (Address src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
909 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
910 pprInstr (LEA size (OpAddr (Address src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
912 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
913 pprInstr (LEA size (OpAddr (Address src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
915 = pprInstr (ADD size (OpImm displ) dst)
916 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
918 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
919 = pprSizeOp SLIT("dec") size dst
920 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
921 = pprSizeOp SLIT("inc") size dst
922 pprInstr (ADD size src dst)
923 = pprSizeOpOp SLIT("add") size src dst
924 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
925 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
926 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
928 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
929 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
930 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
931 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
932 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
934 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
935 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
936 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
938 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
939 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
940 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
941 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
943 pprInstr (NOP) = ptext SLIT("\tnop")
944 pprInstr (CLTD) = ptext SLIT("\tcltd")
946 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
948 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
950 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
951 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
954 = hcat [ ptext SLIT("\tcall "), pprImm imm ]
956 pprInstr SAHF = ptext SLIT("\tsahf")
957 pprInstr FABS = ptext SLIT("\tfabs")
959 pprInstr (FADD sz src@(OpAddr _))
960 = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
961 pprInstr (FADD sz src)
962 = ptext SLIT("\tfadd")
964 = ptext SLIT("\tfaddp")
965 pprInstr (FMUL sz src)
966 = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
968 = ptext SLIT("\tfmulp")
969 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
970 pprInstr FCHS = ptext SLIT("\tfchs")
971 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
972 pprInstr FCOS = ptext SLIT("\tfcos")
973 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
974 pprInstr (FDIV sz src)
975 = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
977 = ptext SLIT("\tfdivp")
978 pprInstr (FDIVR sz src)
979 = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
981 = ptext SLIT("\tfdivpr")
982 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
983 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
984 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
985 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
986 pprInstr (FLD sz (OpImm (ImmCLbl src)))
987 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
988 pprInstr (FLD sz src)
989 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
990 pprInstr FLD1 = ptext SLIT("\tfld1")
991 pprInstr FLDZ = ptext SLIT("\tfldz")
992 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
993 pprInstr FRNDINT = ptext SLIT("\tfrndint")
994 pprInstr FSIN = ptext SLIT("\tfsin")
995 pprInstr FSQRT = ptext SLIT("\tfsqrt")
996 pprInstr (FST sz dst)
997 = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
998 pprInstr (FSTP sz dst)
999 = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
1000 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
1001 pprInstr (FSUB sz src)
1002 = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
1004 = ptext SLIT("\tfsubp")
1005 pprInstr (FSUBR size src)
1006 = pprSizeOp SLIT("fsubr") size src
1008 = ptext SLIT("\tfsubpr")
1009 pprInstr (FISUBR size op)
1010 = pprSizeAddr SLIT("fisubr") size op
1011 pprInstr FTST = ptext SLIT("\tftst")
1012 pprInstr (FCOMP sz op)
1013 = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
1014 pprInstr FUCOMPP = ptext SLIT("\tfucompp")
1015 pprInstr FXCH = ptext SLIT("\tfxch")
1016 pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
1017 pprInstr FNOP = ptext SLIT("")
1020 Continue with I386-only printing bits and bobs:
1022 pprDollImm :: Imm -> Doc
1024 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1026 pprOperand :: Size -> Operand -> Doc
1027 pprOperand s (OpReg r) = pprReg s r
1028 pprOperand s (OpImm i) = pprDollImm i
1029 pprOperand s (OpAddr ea) = pprAddr ea
1031 pprSizeOp :: FAST_STRING -> Size -> Operand -> Doc
1032 pprSizeOp name size op1
1041 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1042 pprSizeOpOp name size op1 op2
1048 pprOperand size op1,
1053 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1054 pprSizeByteOpOp name size op1 op2
1065 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc
1066 pprSizeOpReg name size op1 reg
1072 pprOperand size op1,
1077 pprSizeAddr :: FAST_STRING -> Size -> Address -> Doc
1078 pprSizeAddr name size op
1087 pprSizeAddrReg :: FAST_STRING -> Size -> Address -> Reg -> Doc
1088 pprSizeAddrReg name size op dst
1099 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1100 pprOpOp name size op1 op2
1104 pprOperand size op1,
1109 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc
1110 pprSizeOpOpCoerce name size1 size2 op1 op2
1111 = hcat [ char '\t', ptext name, space,
1112 pprOperand size1 op1,
1114 pprOperand size2 op2
1117 pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc
1118 pprCondInstr name cond arg
1119 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1121 #endif {-i386_TARGET_ARCH-}
1124 %************************************************************************
1126 \subsubsection{@pprInstr@ for a SPARC}
1128 %************************************************************************
1131 #if sparc_TARGET_ARCH
1133 -- a clumsy hack for now, to handle possible double alignment problems
1135 -- even clumsier, to allow for RegReg regs that show when doing indexed
1136 -- reads (bytearrays).
1138 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1140 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1141 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1142 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1145 pprInstr (LD DF addr reg) | maybeToBool off_addr
1159 off_addr = addrOffset addr 4
1160 addr2 = case off_addr of Just x -> x
1162 pprInstr (LD size addr reg)
1173 -- The same clumsy hack as above
1175 pprInstr (ST DF reg (AddrRegReg g1 g2))
1177 ptext SLIT("\tadd\t"),
1178 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1179 ptext SLIT("\tst\t"),
1180 pprReg reg, pp_comma_lbracket, pprReg g1,
1181 ptext SLIT("]\n\tst\t"),
1182 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1185 pprInstr (ST DF reg addr) | maybeToBool off_addr
1187 ptext SLIT("\tst\t"),
1188 pprReg reg, pp_comma_lbracket, pprAddr addr,
1190 ptext SLIT("]\n\tst\t"),
1191 pprReg (fPair reg), pp_comma_lbracket,
1192 pprAddr addr2, rbrack
1195 off_addr = addrOffset addr 4
1196 addr2 = case off_addr of Just x -> x
1198 -- no distinction is made between signed and unsigned bytes on stores for the
1199 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1200 -- so we call a special-purpose pprSize for ST..
1202 pprInstr (ST size reg addr)
1213 pprInstr (ADD x cc reg1 ri reg2)
1214 | not x && not cc && riZero ri
1215 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1217 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1219 pprInstr (SUB x cc reg1 ri reg2)
1220 | not x && cc && reg2 == g0
1221 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1222 | not x && not cc && riZero ri
1223 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1225 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1227 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1228 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1230 pprInstr (OR b reg1 ri reg2)
1231 | not b && reg1 == g0
1232 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1234 = pprRegRIReg SLIT("or") b reg1 ri reg2
1236 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1238 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1239 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1241 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1242 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1243 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1245 pprInstr (SETHI imm reg)
1247 ptext SLIT("\tsethi\t"),
1253 pprInstr NOP = ptext SLIT("\tnop")
1255 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1256 pprInstr (FABS DF reg1 reg2)
1257 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1258 (if (reg1 == reg2) then empty
1259 else (<>) (char '\n')
1260 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1262 pprInstr (FADD size reg1 reg2 reg3)
1263 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1264 pprInstr (FCMP e size reg1 reg2)
1265 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1266 pprInstr (FDIV size reg1 reg2 reg3)
1267 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1269 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1270 pprInstr (FMOV DF reg1 reg2)
1271 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1272 (if (reg1 == reg2) then empty
1273 else (<>) (char '\n')
1274 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1276 pprInstr (FMUL size reg1 reg2 reg3)
1277 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1279 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1280 pprInstr (FNEG DF reg1 reg2)
1281 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1282 (if (reg1 == reg2) then empty
1283 else (<>) (char '\n')
1284 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1286 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1287 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1288 pprInstr (FxTOy size1 size2 reg1 reg2)
1301 pprReg reg1, comma, pprReg reg2
1305 pprInstr (BI cond b lab)
1307 ptext SLIT("\tb"), pprCond cond,
1308 if b then pp_comma_a else empty,
1313 pprInstr (BF cond b lab)
1315 ptext SLIT("\tfb"), pprCond cond,
1316 if b then pp_comma_a else empty,
1321 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1323 pprInstr (CALL imm n _)
1324 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1327 Continue with SPARC-only printing bits and bobs:
1330 pprRI (RIReg r) = pprReg r
1331 pprRI (RIImm r) = pprImm r
1333 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
1334 pprSizeRegReg name size reg1 reg2
1339 F -> ptext SLIT("s\t")
1340 DF -> ptext SLIT("d\t")),
1346 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
1347 pprSizeRegRegReg name size reg1 reg2 reg3
1352 F -> ptext SLIT("s\t")
1353 DF -> ptext SLIT("d\t")),
1361 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc
1362 pprRegRIReg name b reg1 ri reg2
1366 if b then ptext SLIT("cc\t") else char '\t',
1374 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc
1375 pprRIReg name b ri reg1
1379 if b then ptext SLIT("cc\t") else char '\t',
1385 pp_ld_lbracket = ptext (pACK_STR (a_HASH "\tld\t["#))
1386 pp_rbracket_comma = ptext (pACK_STR (a_HASH "],"#))
1387 pp_comma_lbracket = ptext (pACK_STR (a_HASH ",["#))
1388 pp_comma_a = ptext (pACK_STR (a_HASH ",a"#))
1390 #endif {-sparc_TARGET_ARCH-}