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
20 #elif __GLASGOW_HASKELL__ >= 202
27 import MachRegs -- may differ per-platform
30 import AbsCSyn ( MagicId )
31 import CLabel ( pprCLabel_asm, externallyVisibleCLabel )
32 import CStrings ( charToC )
33 import Maybes ( maybeToBool )
34 import OrdList ( OrdList )
35 import Stix ( CodeSegment(..), StixTree )
36 import Pretty -- all of it
38 #if __GLASGOW_HASKELL__ == 201
39 a_HASH x = GHCbase.A# x
40 pACK_STR x = packCString x
43 pACK_STR x = mkFastCharString x --_packCString x
47 %************************************************************************
49 \subsection{@pprReg@: print a @Reg@}
51 %************************************************************************
53 For x86, the way we print a register name depends
54 on which bit of it we care about. Yurgh.
56 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc
58 pprReg IF_ARCH_i386(s,) r
60 FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
61 MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
62 other -> text (show other) -- should only happen when debugging
65 ppr_reg_no :: FAST_REG_NO -> Doc
68 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
69 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
70 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
71 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
72 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
73 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
74 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
75 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
76 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
77 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
78 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
79 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
80 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
81 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
82 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
83 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
84 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
85 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
86 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
87 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
88 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
89 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
90 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
91 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
92 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
93 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
94 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
95 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
96 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
97 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
98 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
99 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
100 _ -> SLIT("very naughty alpha register")
104 ppr_reg_no :: Size -> FAST_REG_NO -> Doc
105 ppr_reg_no B i = ptext
107 ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl");
108 ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl");
109 _ -> SLIT("very naughty I386 byte register")
113 ppr_reg_no HB i = ptext
115 ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh");
116 ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh");
117 _ -> SLIT("very naughty I386 high byte register")
122 ppr_reg_no S i = ptext
124 ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx");
125 ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx");
126 ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
127 ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
128 _ -> SLIT("very naughty I386 word register")
132 ppr_reg_no L i = ptext
134 ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
135 ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
136 ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
137 ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
138 _ -> SLIT("very naughty I386 double word register")
141 ppr_reg_no F i = ptext
143 --ToDo: rm these (???)
144 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
145 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
146 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
147 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
148 _ -> SLIT("very naughty I386 float register")
151 ppr_reg_no DF i = ptext
153 --ToDo: rm these (???)
154 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
155 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
156 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
157 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
158 _ -> SLIT("very naughty I386 float register")
161 #if sparc_TARGET_ARCH
162 ppr_reg_no :: FAST_REG_NO -> Doc
165 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
166 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
167 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
168 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
169 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
170 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
171 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
172 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
173 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
174 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
175 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
176 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
177 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
178 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
179 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
180 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
181 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
182 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
183 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
184 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
185 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
186 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
187 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
188 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
189 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
190 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
191 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
192 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
193 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
194 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
195 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
196 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
197 _ -> SLIT("very naughty sparc register")
202 %************************************************************************
204 \subsection{@pprSize@: print a @Size@}
206 %************************************************************************
209 pprSize :: Size -> Doc
211 pprSize x = ptext (case x of
212 #if alpha_TARGET_ARCH
215 -- W -> SLIT("w") UNUSED
216 -- WU -> SLIT("wu") UNUSED
217 -- L -> SLIT("l") UNUSED
219 -- FF -> SLIT("f") UNUSED
220 -- DF -> SLIT("d") UNUSED
221 -- GF -> SLIT("g") UNUSED
222 -- SF -> SLIT("s") UNUSED
227 -- HB -> SLIT("b") UNUSED
228 -- S -> SLIT("w") UNUSED
233 #if sparc_TARGET_ARCH
236 -- HW -> SLIT("hw") UNUSED
237 -- HWU -> SLIT("uhw") UNUSED
240 -- D -> SLIT("d") UNUSED
243 pprStSize :: Size -> Doc
244 pprStSize x = ptext (case x of
247 -- HW -> SLIT("hw") UNUSED
248 -- HWU -> SLIT("uhw") UNUSED
251 -- D -> SLIT("d") UNUSED
257 %************************************************************************
259 \subsection{@pprCond@: print a @Cond@}
261 %************************************************************************
264 pprCond :: Cond -> Doc
266 pprCond c = ptext (case c of {
267 #if alpha_TARGET_ARCH
278 GEU -> SLIT("ae"); LU -> SLIT("b");
279 EQQ -> SLIT("e"); GTT -> SLIT("g");
280 GE -> SLIT("ge"); GU -> SLIT("a");
281 LTT -> SLIT("l"); LE -> SLIT("le");
282 LEU -> SLIT("be"); NE -> SLIT("ne");
283 NEG -> SLIT("s"); POS -> SLIT("ns");
284 ALWAYS -> SLIT("mp") -- hack
286 #if sparc_TARGET_ARCH
287 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
288 GEU -> SLIT("geu"); LU -> SLIT("lu");
289 EQQ -> SLIT("e"); GTT -> SLIT("g");
290 GE -> SLIT("ge"); GU -> SLIT("gu");
291 LTT -> SLIT("l"); LE -> SLIT("le");
292 LEU -> SLIT("leu"); NE -> SLIT("ne");
293 NEG -> SLIT("neg"); POS -> SLIT("pos");
294 VC -> SLIT("vc"); VS -> SLIT("vs")
299 %************************************************************************
301 \subsection{@pprImm@: print an @Imm@}
303 %************************************************************************
308 pprImm (ImmInt i) = int i
309 pprImm (ImmInteger i) = integer i
310 pprImm (ImmCLbl l) = pprCLabel_asm l
311 pprImm (ImmLit s) = s
313 pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s
316 #if sparc_TARGET_ARCH
318 = hcat [ pp_lo, pprImm i, rparen ]
320 pp_lo = ptext (pACK_STR (a_HASH "%lo("#))
323 = hcat [ pp_hi, pprImm i, rparen ]
325 pp_hi = ptext (pACK_STR (a_HASH "%hi("#))
329 %************************************************************************
331 \subsection{@pprAddr@: print an @Addr@}
333 %************************************************************************
336 pprAddr :: Address -> Doc
338 #if alpha_TARGET_ARCH
339 pprAddr (AddrReg r) = parens (pprReg r)
340 pprAddr (AddrImm i) = pprImm i
341 pprAddr (AddrRegImm r1 i)
342 = (<>) (pprImm i) (parens (pprReg r1))
348 pprAddr (ImmAddr imm off)
354 else if (off < 0) then
355 (<>) pp_imm (int off)
357 hcat [pp_imm, char '+', int off]
359 pprAddr (Address base index displacement)
361 pp_disp = ppr_disp displacement
362 pp_off p = (<>) pp_disp (parens p)
363 pp_reg r = pprReg L r
366 (Nothing, Nothing) -> pp_disp
367 (Just b, Nothing) -> pp_off (pp_reg b)
368 (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i])
369 (Just b, Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i])
371 ppr_disp (ImmInt 0) = empty
372 ppr_disp imm = pprImm imm
377 #if sparc_TARGET_ARCH
378 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
380 pprAddr (AddrRegReg r1 r2)
381 = hcat [ pprReg r1, char '+', pprReg r2 ]
383 pprAddr (AddrRegImm r1 (ImmInt i))
385 | not (fits13Bits i) = largeOffsetError i
386 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
388 pp_sign = if i > 0 then char '+' else empty
390 pprAddr (AddrRegImm r1 (ImmInteger i))
392 | not (fits13Bits i) = largeOffsetError i
393 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
395 pp_sign = if i > 0 then char '+' else empty
397 pprAddr (AddrRegImm r1 imm)
398 = hcat [ pprReg r1, char '+', pprImm imm ]
402 %************************************************************************
404 \subsection{@pprInstr@: print an @Instr@}
406 %************************************************************************
409 pprInstr :: Instr -> Doc
411 --pprInstr (COMMENT s) = (<>) (ptext SLIT("# ")) (ptext s)
412 pprInstr (COMMENT s) = empty -- nuke 'em
413 --alpha: = (<>) (ptext SLIT("\t# ")) (ptext s)
414 --i386 : = (<>) (ptext SLIT("# ")) (ptext s)
415 --sparc: = (<>) (ptext SLIT("! ")) (ptext s)
417 pprInstr (SEGMENT TextSegment)
419 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
420 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
421 ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-}
424 pprInstr (SEGMENT DataSegment)
426 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
427 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
428 ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
431 pprInstr (LABEL clab)
433 pp_lab = pprCLabel_asm clab
436 if not (externallyVisibleCLabel clab) then
440 IF_ARCH_alpha(SLIT("\t.globl\t")
441 ,IF_ARCH_i386(SLIT(".globl ")
442 ,IF_ARCH_sparc(SLIT("\t.global\t")
444 , pp_lab, char '\n'],
449 pprInstr (ASCII False{-no backslash conversion-} str)
450 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
452 pprInstr (ASCII True str)
453 = (<>) (text "\t.ascii \"") (asciify str 60)
455 asciify :: String -> Int -> Doc
457 asciify [] _ = text "\\0\""
458 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
459 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
460 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
461 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
462 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\""))
463 asciify (c:(cs@(d:_))) n
464 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
465 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
468 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
471 #if alpha_TARGET_ARCH
472 B -> SLIT("\t.byte\t")
473 BU -> SLIT("\t.byte\t")
474 --UNUSED: W -> SLIT("\t.word\t")
475 --UNUSED: WU -> SLIT("\t.word\t")
476 --UNUSED: L -> SLIT("\t.long\t")
477 Q -> SLIT("\t.quad\t")
478 --UNUSED: FF -> SLIT("\t.f_floating\t")
479 --UNUSED: DF -> SLIT("\t.d_floating\t")
480 --UNUSED: GF -> SLIT("\t.g_floating\t")
481 --UNUSED: SF -> SLIT("\t.s_floating\t")
482 TF -> SLIT("\t.t_floating\t")
485 B -> SLIT("\t.byte\t")
486 --UNUSED: HB -> SLIT("\t.byte\t")
487 --UNUSED: S -> SLIT("\t.word\t")
488 L -> SLIT("\t.long\t")
489 F -> SLIT("\t.long\t")
490 DF -> SLIT("\t.double\t")
492 #if sparc_TARGET_ARCH
493 B -> SLIT("\t.byte\t")
494 BU -> SLIT("\t.byte\t")
495 W -> SLIT("\t.word\t")
496 DF -> SLIT("\t.double\t")
499 -- fall through to rest of (machine-specific) pprInstr...
502 %************************************************************************
504 \subsubsection{@pprInstr@ for an Alpha}
506 %************************************************************************
509 #if alpha_TARGET_ARCH
511 pprInstr (LD size reg addr)
521 pprInstr (LDA reg addr)
523 ptext SLIT("\tlda\t"),
529 pprInstr (LDAH reg addr)
531 ptext SLIT("\tldah\t"),
537 pprInstr (LDGP reg addr)
539 ptext SLIT("\tldgp\t"),
545 pprInstr (LDI size reg imm)
555 pprInstr (ST size reg addr)
567 ptext SLIT("\tclr\t"),
571 pprInstr (ABS size ri reg)
581 pprInstr (NEG size ov ri reg)
585 if ov then ptext SLIT("v\t") else char '\t',
591 pprInstr (ADD size ov reg1 ri reg2)
595 if ov then ptext SLIT("v\t") else char '\t',
603 pprInstr (SADD size scale reg1 ri reg2)
605 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
616 pprInstr (SUB size ov reg1 ri reg2)
620 if ov then ptext SLIT("v\t") else char '\t',
628 pprInstr (SSUB size scale reg1 ri reg2)
630 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
641 pprInstr (MUL size ov reg1 ri reg2)
645 if ov then ptext SLIT("v\t") else char '\t',
653 pprInstr (DIV size uns reg1 ri reg2)
657 if uns then ptext SLIT("u\t") else char '\t',
665 pprInstr (REM size uns reg1 ri reg2)
669 if uns then ptext SLIT("u\t") else char '\t',
677 pprInstr (NOT ri reg)
686 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
687 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
688 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
689 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
690 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
691 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
693 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
694 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
695 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
697 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
698 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
700 pprInstr (NOP) = ptext SLIT("\tnop")
702 pprInstr (CMP cond reg1 ri reg2)
716 ptext SLIT("\tfclr\t"),
720 pprInstr (FABS reg1 reg2)
722 ptext SLIT("\tfabs\t"),
728 pprInstr (FNEG size reg1 reg2)
738 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
739 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
740 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
741 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
743 pprInstr (CVTxy size1 size2 reg1 reg2)
747 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
754 pprInstr (FCMP size cond reg1 reg2 reg3)
767 pprInstr (FMOV reg1 reg2)
769 ptext SLIT("\tfmov\t"),
775 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
777 pprInstr (BI NEVER reg lab) = empty
779 pprInstr (BI cond reg lab)
789 pprInstr (BF cond reg lab)
800 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
802 pprInstr (JMP reg addr hint)
804 ptext SLIT("\tjmp\t"),
813 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
815 pprInstr (JSR reg addr n)
817 ptext SLIT("\tjsr\t"),
823 pprInstr (FUNBEGIN clab)
825 if (externallyVisibleCLabel clab) then
826 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
829 ptext SLIT("\t.ent "),
838 pp_lab = pprCLabel_asm clab
840 pp_ldgp = ptext (pACK_STR (a_HASH ":\n\tldgp $29,0($27)\n"#))
841 pp_frame = ptext (pACK_STR (a_HASH "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#))
843 pprInstr (FUNEND clab)
844 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
847 Continue with Alpha-only printing bits and bobs:
851 pprRI (RIReg r) = pprReg r
852 pprRI (RIImm r) = pprImm r
854 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Doc
856 pprRegRIReg name reg1 ri reg2
868 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
870 pprSizeRegRegReg name size reg1 reg2 reg3
883 #endif {-alpha_TARGET_ARCH-}
886 %************************************************************************
888 \subsubsection{@pprInstr@ for an I386}
890 %************************************************************************
895 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
899 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
903 pprInstr (MOV size src dst)
904 = pprSizeOpOp SLIT("mov") size src dst
905 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
906 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
908 -- here we do some patching, since the physical registers are only set late
909 -- in the code generation.
910 pprInstr (LEA size (OpAddr (Address src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
912 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
913 pprInstr (LEA size (OpAddr (Address src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
915 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
916 pprInstr (LEA size (OpAddr (Address src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
918 = pprInstr (ADD size (OpImm displ) dst)
919 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
921 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
922 = pprSizeOp SLIT("dec") size dst
923 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
924 = pprSizeOp SLIT("inc") size dst
925 pprInstr (ADD size src dst)
926 = pprSizeOpOp SLIT("add") size src dst
927 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
928 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
929 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
931 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
932 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
933 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
934 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
935 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
937 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
938 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
939 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
941 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
942 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
943 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
944 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
946 pprInstr (NOP) = ptext SLIT("\tnop")
947 pprInstr (CLTD) = ptext SLIT("\tcltd")
949 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
951 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
953 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
954 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
957 = hcat [ ptext SLIT("\tcall "), pprImm imm ]
959 pprInstr SAHF = ptext SLIT("\tsahf")
960 pprInstr FABS = ptext SLIT("\tfabs")
962 pprInstr (FADD sz src@(OpAddr _))
963 = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
964 pprInstr (FADD sz src)
965 = ptext SLIT("\tfadd")
967 = ptext SLIT("\tfaddp")
968 pprInstr (FMUL sz src)
969 = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
971 = ptext SLIT("\tfmulp")
972 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
973 pprInstr FCHS = ptext SLIT("\tfchs")
974 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
975 pprInstr FCOS = ptext SLIT("\tfcos")
976 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
977 pprInstr (FDIV sz src)
978 = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
980 = ptext SLIT("\tfdivp")
981 pprInstr (FDIVR sz src)
982 = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
984 = ptext SLIT("\tfdivpr")
985 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
986 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
987 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
988 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
989 pprInstr (FLD sz (OpImm (ImmCLbl src)))
990 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
991 pprInstr (FLD sz src)
992 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
993 pprInstr FLD1 = ptext SLIT("\tfld1")
994 pprInstr FLDZ = ptext SLIT("\tfldz")
995 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
996 pprInstr FRNDINT = ptext SLIT("\tfrndint")
997 pprInstr FSIN = ptext SLIT("\tfsin")
998 pprInstr FSQRT = ptext SLIT("\tfsqrt")
999 pprInstr (FST sz dst)
1000 = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
1001 pprInstr (FSTP sz dst)
1002 = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
1003 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
1004 pprInstr (FSUB sz src)
1005 = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
1007 = ptext SLIT("\tfsubp")
1008 pprInstr (FSUBR size src)
1009 = pprSizeOp SLIT("fsubr") size src
1011 = ptext SLIT("\tfsubpr")
1012 pprInstr (FISUBR size op)
1013 = pprSizeAddr SLIT("fisubr") size op
1014 pprInstr FTST = ptext SLIT("\tftst")
1015 pprInstr (FCOMP sz op)
1016 = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
1017 pprInstr FUCOMPP = ptext SLIT("\tfucompp")
1018 pprInstr FXCH = ptext SLIT("\tfxch")
1019 pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
1020 pprInstr FNOP = ptext SLIT("")
1023 Continue with I386-only printing bits and bobs:
1025 pprDollImm :: Imm -> Doc
1027 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1029 pprOperand :: Size -> Operand -> Doc
1030 pprOperand s (OpReg r) = pprReg s r
1031 pprOperand s (OpImm i) = pprDollImm i
1032 pprOperand s (OpAddr ea) = pprAddr ea
1034 pprSizeOp :: FAST_STRING -> Size -> Operand -> Doc
1035 pprSizeOp name size op1
1044 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1045 pprSizeOpOp name size op1 op2
1051 pprOperand size op1,
1056 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1057 pprSizeByteOpOp name size op1 op2
1068 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc
1069 pprSizeOpReg name size op1 reg
1075 pprOperand size op1,
1080 pprSizeAddr :: FAST_STRING -> Size -> Address -> Doc
1081 pprSizeAddr name size op
1090 pprSizeAddrReg :: FAST_STRING -> Size -> Address -> Reg -> Doc
1091 pprSizeAddrReg name size op dst
1102 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1103 pprOpOp name size op1 op2
1107 pprOperand size op1,
1112 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc
1113 pprSizeOpOpCoerce name size1 size2 op1 op2
1114 = hcat [ char '\t', ptext name, space,
1115 pprOperand size1 op1,
1117 pprOperand size2 op2
1120 pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc
1121 pprCondInstr name cond arg
1122 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1124 #endif {-i386_TARGET_ARCH-}
1127 %************************************************************************
1129 \subsubsection{@pprInstr@ for a SPARC}
1131 %************************************************************************
1134 #if sparc_TARGET_ARCH
1136 -- a clumsy hack for now, to handle possible double alignment problems
1138 -- even clumsier, to allow for RegReg regs that show when doing indexed
1139 -- reads (bytearrays).
1141 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1143 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1144 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1145 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1148 pprInstr (LD DF addr reg) | maybeToBool off_addr
1162 off_addr = addrOffset addr 4
1163 addr2 = case off_addr of Just x -> x
1165 pprInstr (LD size addr reg)
1176 -- The same clumsy hack as above
1178 pprInstr (ST DF reg (AddrRegReg g1 g2))
1180 ptext SLIT("\tadd\t"),
1181 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1182 ptext SLIT("\tst\t"),
1183 pprReg reg, pp_comma_lbracket, pprReg g1,
1184 ptext SLIT("]\n\tst\t"),
1185 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1188 pprInstr (ST DF reg addr) | maybeToBool off_addr
1190 ptext SLIT("\tst\t"),
1191 pprReg reg, pp_comma_lbracket, pprAddr addr,
1193 ptext SLIT("]\n\tst\t"),
1194 pprReg (fPair reg), pp_comma_lbracket,
1195 pprAddr addr2, rbrack
1198 off_addr = addrOffset addr 4
1199 addr2 = case off_addr of Just x -> x
1201 -- no distinction is made between signed and unsigned bytes on stores for the
1202 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1203 -- so we call a special-purpose pprSize for ST..
1205 pprInstr (ST size reg addr)
1216 pprInstr (ADD x cc reg1 ri reg2)
1217 | not x && not cc && riZero ri
1218 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1220 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1222 pprInstr (SUB x cc reg1 ri reg2)
1223 | not x && cc && reg2 == g0
1224 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1225 | not x && not cc && riZero ri
1226 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1228 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1230 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1231 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1233 pprInstr (OR b reg1 ri reg2)
1234 | not b && reg1 == g0
1235 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1237 = pprRegRIReg SLIT("or") b reg1 ri reg2
1239 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1241 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1242 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1244 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1245 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1246 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1248 pprInstr (SETHI imm reg)
1250 ptext SLIT("\tsethi\t"),
1256 pprInstr NOP = ptext SLIT("\tnop")
1258 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1259 pprInstr (FABS DF reg1 reg2)
1260 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1261 (if (reg1 == reg2) then empty
1262 else (<>) (char '\n')
1263 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1265 pprInstr (FADD size reg1 reg2 reg3)
1266 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1267 pprInstr (FCMP e size reg1 reg2)
1268 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1269 pprInstr (FDIV size reg1 reg2 reg3)
1270 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1272 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1273 pprInstr (FMOV DF reg1 reg2)
1274 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1275 (if (reg1 == reg2) then empty
1276 else (<>) (char '\n')
1277 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1279 pprInstr (FMUL size reg1 reg2 reg3)
1280 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1282 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1283 pprInstr (FNEG DF reg1 reg2)
1284 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1285 (if (reg1 == reg2) then empty
1286 else (<>) (char '\n')
1287 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1289 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1290 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1291 pprInstr (FxTOy size1 size2 reg1 reg2)
1304 pprReg reg1, comma, pprReg reg2
1308 pprInstr (BI cond b lab)
1310 ptext SLIT("\tb"), pprCond cond,
1311 if b then pp_comma_a else empty,
1316 pprInstr (BF cond b lab)
1318 ptext SLIT("\tfb"), pprCond cond,
1319 if b then pp_comma_a else empty,
1324 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1326 pprInstr (CALL imm n _)
1327 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1330 Continue with SPARC-only printing bits and bobs:
1333 pprRI (RIReg r) = pprReg r
1334 pprRI (RIImm r) = pprImm r
1336 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
1337 pprSizeRegReg name size reg1 reg2
1342 F -> ptext SLIT("s\t")
1343 DF -> ptext SLIT("d\t")),
1349 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
1350 pprSizeRegRegReg name size reg1 reg2 reg3
1355 F -> ptext SLIT("s\t")
1356 DF -> ptext SLIT("d\t")),
1364 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc
1365 pprRegRIReg name b reg1 ri reg2
1369 if b then ptext SLIT("cc\t") else char '\t',
1377 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc
1378 pprRIReg name b ri reg1
1382 if b then ptext SLIT("cc\t") else char '\t',
1388 pp_ld_lbracket = ptext (pACK_STR (a_HASH "\tld\t["#))
1389 pp_rbracket_comma = ptext (pACK_STR (a_HASH "],"#))
1390 pp_comma_lbracket = ptext (pACK_STR (a_HASH ",["#))
1391 pp_comma_a = ptext (pACK_STR (a_HASH ",a"#))
1393 #endif {-sparc_TARGET_ARCH-}