2 % (c) The AQUA Project, Glasgow University, 1996-1998
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 "nativeGen/NCG.h"
13 module PprMach ( pprInstr ) where
15 #include "HsVersions.h"
17 import MachRegs -- may differ per-platform
20 import CLabel ( pprCLabel_asm, externallyVisibleCLabel )
21 import CStrings ( charToC )
22 import Maybes ( maybeToBool )
23 import Stix ( CodeSegment(..) )
24 import Char ( isPrint, isDigit )
28 %************************************************************************
30 \subsection{@pprReg@: print a @Reg@}
32 %************************************************************************
34 For x86, the way we print a register name depends
35 on which bit of it we care about. Yurgh.
37 pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc
39 pprReg IF_ARCH_i386(s,) r
41 FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
42 MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
43 other -> text (show other) -- should only happen when debugging
46 ppr_reg_no :: FAST_REG_NO -> SDoc
49 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
50 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
51 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
52 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
53 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
54 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
55 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
56 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
57 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
58 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
59 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
60 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
61 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
62 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
63 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
64 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
65 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
66 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
67 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
68 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
69 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
70 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
71 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
72 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
73 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
74 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
75 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
76 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
77 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
78 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
79 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
80 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
81 _ -> SLIT("very naughty alpha register")
85 ppr_reg_no :: Size -> FAST_REG_NO -> SDoc
86 ppr_reg_no B i = ptext
88 ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl");
89 ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl");
90 _ -> SLIT("very naughty I386 byte register")
94 ppr_reg_no HB i = ptext
96 ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh");
97 ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh");
98 _ -> SLIT("very naughty I386 high byte register")
103 ppr_reg_no S i = ptext
105 ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx");
106 ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx");
107 ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
108 ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
109 _ -> SLIT("very naughty I386 word register")
113 ppr_reg_no L i = ptext
115 ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
116 ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
117 ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
118 ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
119 _ -> SLIT("very naughty I386 double word register")
122 ppr_reg_no F i = ptext
124 --ToDo: rm these (???)
125 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
126 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
127 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
128 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
129 _ -> SLIT("very naughty I386 float register")
132 ppr_reg_no DF i = ptext
134 --ToDo: rm these (???)
135 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
136 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
137 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
138 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
139 _ -> SLIT("very naughty I386 float register")
142 #if sparc_TARGET_ARCH
143 ppr_reg_no :: FAST_REG_NO -> SDoc
146 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
147 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
148 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
149 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
150 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
151 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
152 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
153 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
154 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
155 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
156 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
157 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
158 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
159 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
160 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
161 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
162 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
163 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
164 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
165 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
166 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
167 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
168 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
169 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
170 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
171 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
172 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
173 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
174 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
175 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
176 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
177 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
178 _ -> SLIT("very naughty sparc register")
183 %************************************************************************
185 \subsection{@pprSize@: print a @Size@}
187 %************************************************************************
190 pprSize :: Size -> SDoc
192 pprSize x = ptext (case x of
193 #if alpha_TARGET_ARCH
196 -- W -> SLIT("w") UNUSED
197 -- WU -> SLIT("wu") UNUSED
198 -- L -> SLIT("l") UNUSED
200 -- FF -> SLIT("f") UNUSED
201 -- DF -> SLIT("d") UNUSED
202 -- GF -> SLIT("g") UNUSED
203 -- SF -> SLIT("s") UNUSED
208 -- HB -> SLIT("b") UNUSED
209 -- S -> SLIT("w") UNUSED
214 #if sparc_TARGET_ARCH
217 -- HW -> SLIT("hw") UNUSED
218 -- HWU -> SLIT("uhw") UNUSED
221 -- D -> SLIT("d") UNUSED
224 pprStSize :: Size -> SDoc
225 pprStSize x = ptext (case x of
228 -- HW -> SLIT("hw") UNUSED
229 -- HWU -> SLIT("uhw") UNUSED
232 -- D -> SLIT("d") UNUSED
238 %************************************************************************
240 \subsection{@pprCond@: print a @Cond@}
242 %************************************************************************
245 pprCond :: Cond -> SDoc
247 pprCond c = ptext (case c of {
248 #if alpha_TARGET_ARCH
259 GEU -> SLIT("ae"); LU -> SLIT("b");
260 EQQ -> SLIT("e"); GTT -> SLIT("g");
261 GE -> SLIT("ge"); GU -> SLIT("a");
262 LTT -> SLIT("l"); LE -> SLIT("le");
263 LEU -> SLIT("be"); NE -> SLIT("ne");
264 NEG -> SLIT("s"); POS -> SLIT("ns");
265 ALWAYS -> SLIT("mp") -- hack
267 #if sparc_TARGET_ARCH
268 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
269 GEU -> SLIT("geu"); LU -> SLIT("lu");
270 EQQ -> SLIT("e"); GTT -> SLIT("g");
271 GE -> SLIT("ge"); GU -> SLIT("gu");
272 LTT -> SLIT("l"); LE -> SLIT("le");
273 LEU -> SLIT("leu"); NE -> SLIT("ne");
274 NEG -> SLIT("neg"); POS -> SLIT("pos");
275 VC -> SLIT("vc"); VS -> SLIT("vs")
280 %************************************************************************
282 \subsection{@pprImm@: print an @Imm@}
284 %************************************************************************
287 pprImm :: Imm -> SDoc
289 pprImm (ImmInt i) = int i
290 pprImm (ImmInteger i) = integer i
291 pprImm (ImmCLbl l) = pprCLabel_asm l
292 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
293 pprImm (ImmLit s) = s
295 pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s
298 #if sparc_TARGET_ARCH
300 = hcat [ pp_lo, pprImm i, rparen ]
305 = hcat [ pp_hi, pprImm i, rparen ]
311 %************************************************************************
313 \subsection{@pprAddr@: print an @Addr@}
315 %************************************************************************
318 pprAddr :: MachRegsAddr -> SDoc
320 #if alpha_TARGET_ARCH
321 pprAddr (AddrReg r) = parens (pprReg r)
322 pprAddr (AddrImm i) = pprImm i
323 pprAddr (AddrRegImm r1 i)
324 = (<>) (pprImm i) (parens (pprReg r1))
330 pprAddr (ImmAddr imm off)
336 else if (off < 0) then
337 (<>) pp_imm (int off)
339 hcat [pp_imm, char '+', int off]
341 pprAddr (AddrBaseIndex base index displacement)
343 pp_disp = ppr_disp displacement
344 pp_off p = (<>) pp_disp (parens p)
345 pp_reg r = pprReg L r
348 (Nothing, Nothing) -> pp_disp
349 (Just b, Nothing) -> pp_off (pp_reg b)
350 (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i])
351 (Just b, Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i])
353 ppr_disp (ImmInt 0) = empty
354 ppr_disp imm = pprImm imm
359 #if sparc_TARGET_ARCH
360 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
362 pprAddr (AddrRegReg r1 r2)
363 = hcat [ pprReg r1, char '+', pprReg r2 ]
365 pprAddr (AddrRegImm r1 (ImmInt i))
367 | not (fits13Bits i) = largeOffsetError i
368 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
370 pp_sign = if i > 0 then char '+' else empty
372 pprAddr (AddrRegImm r1 (ImmInteger i))
374 | not (fits13Bits i) = largeOffsetError i
375 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
377 pp_sign = if i > 0 then char '+' else empty
379 pprAddr (AddrRegImm r1 imm)
380 = hcat [ pprReg r1, char '+', pprImm imm ]
384 %************************************************************************
386 \subsection{@pprInstr@: print an @Instr@}
388 %************************************************************************
391 pprInstr :: Instr -> SDoc
393 --pprInstr (COMMENT s) = (<>) (ptext SLIT("# ")) (ptext s)
394 pprInstr (COMMENT s) = empty -- nuke 'em
395 --alpha: = (<>) (ptext SLIT("\t# ")) (ptext s)
396 --i386 : = (<>) (ptext SLIT("# ")) (ptext s)
397 --sparc: = (<>) (ptext SLIT("! ")) (ptext s)
399 pprInstr (SEGMENT TextSegment)
401 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
402 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
403 ,IF_ARCH_i386((_PK_ ".text\n\t.align 4") {-needs per-OS variation!-}
407 ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-}
410 pprInstr (SEGMENT DataSegment)
412 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
413 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
414 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
418 ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
421 pprInstr (LABEL clab)
423 pp_lab = pprCLabel_asm clab
426 if not (externallyVisibleCLabel clab) then
430 IF_ARCH_alpha(SLIT("\t.globl\t")
431 ,IF_ARCH_i386(SLIT(".globl ")
432 ,IF_ARCH_sparc(SLIT("\t.global\t")
434 , pp_lab, char '\n'],
439 pprInstr (ASCII False{-no backslash conversion-} str)
440 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
442 pprInstr (ASCII True str)
443 = (<>) (text "\t.ascii \"") (asciify str 60)
445 asciify :: String -> Int -> SDoc
447 asciify [] _ = text "\\0\""
448 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
449 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
450 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
451 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
452 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-}
453 asciify (c:(cs@(d:_))) n
454 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
455 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
458 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
461 #if alpha_TARGET_ARCH
462 B -> SLIT("\t.byte\t")
463 BU -> SLIT("\t.byte\t")
464 --UNUSED: W -> SLIT("\t.word\t")
465 --UNUSED: WU -> SLIT("\t.word\t")
466 --UNUSED: L -> SLIT("\t.long\t")
467 Q -> SLIT("\t.quad\t")
468 --UNUSED: FF -> SLIT("\t.f_floating\t")
469 --UNUSED: DF -> SLIT("\t.d_floating\t")
470 --UNUSED: GF -> SLIT("\t.g_floating\t")
471 --UNUSED: SF -> SLIT("\t.s_floating\t")
472 TF -> SLIT("\t.t_floating\t")
475 B -> SLIT("\t.byte\t")
476 --UNUSED: HB -> SLIT("\t.byte\t")
477 --UNUSED: S -> SLIT("\t.word\t")
478 L -> SLIT("\t.long\t")
479 F -> SLIT("\t.float\t")
480 DF -> SLIT("\t.double\t")
482 #if sparc_TARGET_ARCH
483 B -> SLIT("\t.byte\t")
484 BU -> SLIT("\t.byte\t")
485 W -> SLIT("\t.word\t")
486 DF -> SLIT("\t.double\t")
489 -- fall through to rest of (machine-specific) pprInstr...
492 %************************************************************************
494 \subsubsection{@pprInstr@ for an Alpha}
496 %************************************************************************
499 #if alpha_TARGET_ARCH
501 pprInstr (LD size reg addr)
511 pprInstr (LDA reg addr)
513 ptext SLIT("\tlda\t"),
519 pprInstr (LDAH reg addr)
521 ptext SLIT("\tldah\t"),
527 pprInstr (LDGP reg addr)
529 ptext SLIT("\tldgp\t"),
535 pprInstr (LDI size reg imm)
545 pprInstr (ST size reg addr)
557 ptext SLIT("\tclr\t"),
561 pprInstr (ABS size ri reg)
571 pprInstr (NEG size ov ri reg)
575 if ov then ptext SLIT("v\t") else char '\t',
581 pprInstr (ADD size ov reg1 ri reg2)
585 if ov then ptext SLIT("v\t") else char '\t',
593 pprInstr (SADD size scale reg1 ri reg2)
595 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
606 pprInstr (SUB size ov reg1 ri reg2)
610 if ov then ptext SLIT("v\t") else char '\t',
618 pprInstr (SSUB size scale reg1 ri reg2)
620 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
631 pprInstr (MUL size ov reg1 ri reg2)
635 if ov then ptext SLIT("v\t") else char '\t',
643 pprInstr (DIV size uns reg1 ri reg2)
647 if uns then ptext SLIT("u\t") else char '\t',
655 pprInstr (REM size uns reg1 ri reg2)
659 if uns then ptext SLIT("u\t") else char '\t',
667 pprInstr (NOT ri reg)
676 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
677 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
678 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
679 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
680 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
681 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
683 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
684 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
685 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
687 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
688 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
690 pprInstr (NOP) = ptext SLIT("\tnop")
692 pprInstr (CMP cond reg1 ri reg2)
706 ptext SLIT("\tfclr\t"),
710 pprInstr (FABS reg1 reg2)
712 ptext SLIT("\tfabs\t"),
718 pprInstr (FNEG size reg1 reg2)
728 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
729 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
730 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
731 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
733 pprInstr (CVTxy size1 size2 reg1 reg2)
737 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
744 pprInstr (FCMP size cond reg1 reg2 reg3)
757 pprInstr (FMOV reg1 reg2)
759 ptext SLIT("\tfmov\t"),
765 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
767 pprInstr (BI NEVER reg lab) = empty
769 pprInstr (BI cond reg lab)
779 pprInstr (BF cond reg lab)
790 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
792 pprInstr (JMP reg addr hint)
794 ptext SLIT("\tjmp\t"),
803 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
805 pprInstr (JSR reg addr n)
807 ptext SLIT("\tjsr\t"),
813 pprInstr (FUNBEGIN clab)
815 if (externallyVisibleCLabel clab) then
816 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
819 ptext SLIT("\t.ent "),
828 pp_lab = pprCLabel_asm clab
830 -- NEVER use commas within those string literals, cpp will ruin your day
831 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
832 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
833 ptext SLIT("4240"), char ',',
834 ptext SLIT("$26"), char ',',
835 ptext SLIT("0\n\t.prologue 1") ]
837 pprInstr (FUNEND clab)
838 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
841 Continue with Alpha-only printing bits and bobs:
845 pprRI (RIReg r) = pprReg r
846 pprRI (RIImm r) = pprImm r
848 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
850 pprRegRIReg name reg1 ri reg2
862 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
864 pprSizeRegRegReg name size reg1 reg2 reg3
877 #endif {-alpha_TARGET_ARCH-}
880 %************************************************************************
882 \subsubsection{@pprInstr@ for an I386}
884 %************************************************************************
889 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
893 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
897 pprInstr (MOV size src dst)
898 = pprSizeOpOp SLIT("mov") size src dst
899 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
900 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
902 -- here we do some patching, since the physical registers are only set late
903 -- in the code generation.
904 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
906 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
907 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
909 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
910 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
912 = pprInstr (ADD size (OpImm displ) dst)
913 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
915 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
916 = pprSizeOp SLIT("dec") size dst
917 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
918 = pprSizeOp SLIT("inc") size dst
919 pprInstr (ADD size src dst)
920 = pprSizeOpOp SLIT("add") size src dst
921 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
922 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
923 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
925 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
926 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
927 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
928 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
929 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
931 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
932 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
933 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
935 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
936 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
937 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
938 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
940 pprInstr (NOP) = ptext SLIT("\tnop")
941 pprInstr (CLTD) = ptext SLIT("\tcltd")
943 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
945 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
947 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
948 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
951 = hcat [ ptext SLIT("\tcall "), pprImm imm ]
953 pprInstr SAHF = ptext SLIT("\tsahf")
954 pprInstr FABS = ptext SLIT("\tfabs")
956 pprInstr (FADD sz src@(OpAddr _))
957 = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
958 pprInstr (FADD sz src)
959 = ptext SLIT("\tfadd")
961 = ptext SLIT("\tfaddp")
962 pprInstr (FMUL sz src)
963 = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
965 = ptext SLIT("\tfmulp")
966 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
967 pprInstr FCHS = ptext SLIT("\tfchs")
968 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
969 pprInstr FCOS = ptext SLIT("\tfcos")
970 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
971 pprInstr (FDIV sz src)
972 = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
974 = ptext SLIT("\tfdivp")
975 pprInstr (FDIVR sz src)
976 = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
978 = ptext SLIT("\tfdivpr")
979 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
980 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
981 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
982 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
983 pprInstr (FLD sz (OpImm (ImmCLbl src)))
984 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
985 pprInstr (FLD sz src)
986 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
987 pprInstr FLD1 = ptext SLIT("\tfld1")
988 pprInstr FLDZ = ptext SLIT("\tfldz")
989 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
990 pprInstr FRNDINT = ptext SLIT("\tfrndint")
991 pprInstr FSIN = ptext SLIT("\tfsin")
992 pprInstr FSQRT = ptext SLIT("\tfsqrt")
993 pprInstr (FST sz dst)
994 = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
995 pprInstr (FSTP sz dst)
996 = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
997 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
998 pprInstr (FSUB sz src)
999 = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
1001 = ptext SLIT("\tfsubp")
1002 pprInstr (FSUBR size src)
1003 = pprSizeOp SLIT("fsubr") size src
1005 = ptext SLIT("\tfsubpr")
1006 pprInstr (FISUBR size op)
1007 = pprSizeAddr SLIT("fisubr") size op
1008 pprInstr FTST = ptext SLIT("\tftst")
1009 pprInstr (FCOMP sz op)
1010 = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
1011 pprInstr FUCOMPP = ptext SLIT("\tfucompp")
1012 pprInstr FXCH = ptext SLIT("\tfxch")
1013 pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
1014 pprInstr FNOP = ptext SLIT("")
1017 Continue with I386-only printing bits and bobs:
1019 pprDollImm :: Imm -> SDoc
1021 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1023 pprOperand :: Size -> Operand -> SDoc
1024 pprOperand s (OpReg r) = pprReg s r
1025 pprOperand s (OpImm i) = pprDollImm i
1026 pprOperand s (OpAddr ea) = pprAddr ea
1028 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1029 pprSizeOp name size op1
1038 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1039 pprSizeOpOp name size op1 op2
1045 pprOperand size op1,
1050 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1051 pprSizeByteOpOp name size op1 op2
1062 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1063 pprSizeOpReg name size op1 reg
1069 pprOperand size op1,
1074 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1075 pprSizeAddr name size op
1084 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1085 pprSizeAddrReg name size op dst
1096 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1097 pprOpOp name size op1 op2
1101 pprOperand size op1,
1106 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1107 pprSizeOpOpCoerce name size1 size2 op1 op2
1108 = hcat [ char '\t', ptext name, space,
1109 pprOperand size1 op1,
1111 pprOperand size2 op2
1114 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1115 pprCondInstr name cond arg
1116 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1118 #endif {-i386_TARGET_ARCH-}
1121 %************************************************************************
1123 \subsubsection{@pprInstr@ for a SPARC}
1125 %************************************************************************
1128 #if sparc_TARGET_ARCH
1130 -- a clumsy hack for now, to handle possible double alignment problems
1132 -- even clumsier, to allow for RegReg regs that show when doing indexed
1133 -- reads (bytearrays).
1135 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1137 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1138 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1139 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1142 pprInstr (LD DF addr reg) | maybeToBool off_addr
1156 off_addr = addrOffset addr 4
1157 addr2 = case off_addr of Just x -> x
1159 pprInstr (LD size addr reg)
1170 -- The same clumsy hack as above
1172 pprInstr (ST DF reg (AddrRegReg g1 g2))
1174 ptext SLIT("\tadd\t"),
1175 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1176 ptext SLIT("\tst\t"),
1177 pprReg reg, pp_comma_lbracket, pprReg g1,
1178 ptext SLIT("]\n\tst\t"),
1179 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1182 pprInstr (ST DF reg addr) | maybeToBool off_addr
1184 ptext SLIT("\tst\t"),
1185 pprReg reg, pp_comma_lbracket, pprAddr addr,
1187 ptext SLIT("]\n\tst\t"),
1188 pprReg (fPair reg), pp_comma_lbracket,
1189 pprAddr addr2, rbrack
1192 off_addr = addrOffset addr 4
1193 addr2 = case off_addr of Just x -> x
1195 -- no distinction is made between signed and unsigned bytes on stores for the
1196 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1197 -- so we call a special-purpose pprSize for ST..
1199 pprInstr (ST size reg addr)
1210 pprInstr (ADD x cc reg1 ri reg2)
1211 | not x && not cc && riZero ri
1212 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1214 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1216 pprInstr (SUB x cc reg1 ri reg2)
1217 | not x && cc && reg2 == g0
1218 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1219 | not x && not cc && riZero ri
1220 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1222 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1224 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1225 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1227 pprInstr (OR b reg1 ri reg2)
1228 | not b && reg1 == g0
1229 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1231 = pprRegRIReg SLIT("or") b reg1 ri reg2
1233 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1235 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1236 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1238 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1239 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1240 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1242 pprInstr (SETHI imm reg)
1244 ptext SLIT("\tsethi\t"),
1250 pprInstr NOP = ptext SLIT("\tnop")
1252 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1253 pprInstr (FABS DF reg1 reg2)
1254 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1255 (if (reg1 == reg2) then empty
1256 else (<>) (char '\n')
1257 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1259 pprInstr (FADD size reg1 reg2 reg3)
1260 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1261 pprInstr (FCMP e size reg1 reg2)
1262 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1263 pprInstr (FDIV size reg1 reg2 reg3)
1264 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1266 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1267 pprInstr (FMOV DF reg1 reg2)
1268 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1269 (if (reg1 == reg2) then empty
1270 else (<>) (char '\n')
1271 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1273 pprInstr (FMUL size reg1 reg2 reg3)
1274 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1276 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1277 pprInstr (FNEG DF reg1 reg2)
1278 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1279 (if (reg1 == reg2) then empty
1280 else (<>) (char '\n')
1281 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1283 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1284 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1285 pprInstr (FxTOy size1 size2 reg1 reg2)
1298 pprReg reg1, comma, pprReg reg2
1302 pprInstr (BI cond b lab)
1304 ptext SLIT("\tb"), pprCond cond,
1305 if b then pp_comma_a else empty,
1310 pprInstr (BF cond b lab)
1312 ptext SLIT("\tfb"), pprCond cond,
1313 if b then pp_comma_a else empty,
1318 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1320 pprInstr (CALL imm n _)
1321 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1324 Continue with SPARC-only printing bits and bobs:
1327 pprRI (RIReg r) = pprReg r
1328 pprRI (RIImm r) = pprImm r
1330 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1331 pprSizeRegReg name size reg1 reg2
1336 F -> ptext SLIT("s\t")
1337 DF -> ptext SLIT("d\t")),
1343 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1344 pprSizeRegRegReg name size reg1 reg2 reg3
1349 F -> ptext SLIT("s\t")
1350 DF -> ptext SLIT("d\t")),
1358 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1359 pprRegRIReg name b reg1 ri reg2
1363 if b then ptext SLIT("cc\t") else char '\t',
1371 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1372 pprRIReg name b ri reg1
1376 if b then ptext SLIT("cc\t") else char '\t',
1382 pp_ld_lbracket = ptext SLIT("\tld\t[")
1383 pp_rbracket_comma = text "],"
1384 pp_comma_lbracket = text ",["
1385 pp_comma_a = text ",a"
1387 #endif {-sparc_TARGET_ARCH-}