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 2\x2c\&0x90") {-needs per-OS variation!-}
406 pprInstr (SEGMENT DataSegment)
408 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
409 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
410 ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
413 pprInstr (LABEL clab)
415 pp_lab = pprCLabel_asm clab
418 if not (externallyVisibleCLabel clab) then
422 IF_ARCH_alpha(SLIT("\t.globl\t")
423 ,IF_ARCH_i386(SLIT(".globl ")
424 ,IF_ARCH_sparc(SLIT("\t.global\t")
426 , pp_lab, char '\n'],
431 pprInstr (ASCII False{-no backslash conversion-} str)
432 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
434 pprInstr (ASCII True str)
435 = (<>) (text "\t.ascii \"") (asciify str 60)
437 asciify :: String -> Int -> SDoc
439 asciify [] _ = text "\\0\""
440 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
441 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
442 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
443 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
444 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-}
445 asciify (c:(cs@(d:_))) n
446 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
447 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
450 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
453 #if alpha_TARGET_ARCH
454 B -> SLIT("\t.byte\t")
455 BU -> SLIT("\t.byte\t")
456 --UNUSED: W -> SLIT("\t.word\t")
457 --UNUSED: WU -> SLIT("\t.word\t")
458 --UNUSED: L -> SLIT("\t.long\t")
459 Q -> SLIT("\t.quad\t")
460 --UNUSED: FF -> SLIT("\t.f_floating\t")
461 --UNUSED: DF -> SLIT("\t.d_floating\t")
462 --UNUSED: GF -> SLIT("\t.g_floating\t")
463 --UNUSED: SF -> SLIT("\t.s_floating\t")
464 TF -> SLIT("\t.t_floating\t")
467 B -> SLIT("\t.byte\t")
468 --UNUSED: HB -> SLIT("\t.byte\t")
469 --UNUSED: S -> SLIT("\t.word\t")
470 L -> SLIT("\t.long\t")
471 F -> SLIT("\t.float\t")
472 DF -> SLIT("\t.double\t")
474 #if sparc_TARGET_ARCH
475 B -> SLIT("\t.byte\t")
476 BU -> SLIT("\t.byte\t")
477 W -> SLIT("\t.word\t")
478 DF -> SLIT("\t.double\t")
481 -- fall through to rest of (machine-specific) pprInstr...
484 %************************************************************************
486 \subsubsection{@pprInstr@ for an Alpha}
488 %************************************************************************
491 #if alpha_TARGET_ARCH
493 pprInstr (LD size reg addr)
503 pprInstr (LDA reg addr)
505 ptext SLIT("\tlda\t"),
511 pprInstr (LDAH reg addr)
513 ptext SLIT("\tldah\t"),
519 pprInstr (LDGP reg addr)
521 ptext SLIT("\tldgp\t"),
527 pprInstr (LDI size reg imm)
537 pprInstr (ST size reg addr)
549 ptext SLIT("\tclr\t"),
553 pprInstr (ABS size ri reg)
563 pprInstr (NEG size ov ri reg)
567 if ov then ptext SLIT("v\t") else char '\t',
573 pprInstr (ADD size ov reg1 ri reg2)
577 if ov then ptext SLIT("v\t") else char '\t',
585 pprInstr (SADD size scale reg1 ri reg2)
587 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
598 pprInstr (SUB size ov reg1 ri reg2)
602 if ov then ptext SLIT("v\t") else char '\t',
610 pprInstr (SSUB size scale reg1 ri reg2)
612 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
623 pprInstr (MUL size ov reg1 ri reg2)
627 if ov then ptext SLIT("v\t") else char '\t',
635 pprInstr (DIV size uns reg1 ri reg2)
639 if uns then ptext SLIT("u\t") else char '\t',
647 pprInstr (REM size uns reg1 ri reg2)
651 if uns then ptext SLIT("u\t") else char '\t',
659 pprInstr (NOT ri reg)
668 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
669 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
670 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
671 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
672 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
673 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
675 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
676 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
677 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
679 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
680 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
682 pprInstr (NOP) = ptext SLIT("\tnop")
684 pprInstr (CMP cond reg1 ri reg2)
698 ptext SLIT("\tfclr\t"),
702 pprInstr (FABS reg1 reg2)
704 ptext SLIT("\tfabs\t"),
710 pprInstr (FNEG size reg1 reg2)
720 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
721 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
722 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
723 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
725 pprInstr (CVTxy size1 size2 reg1 reg2)
729 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
736 pprInstr (FCMP size cond reg1 reg2 reg3)
749 pprInstr (FMOV reg1 reg2)
751 ptext SLIT("\tfmov\t"),
757 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
759 pprInstr (BI NEVER reg lab) = empty
761 pprInstr (BI cond reg lab)
771 pprInstr (BF cond reg lab)
782 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
784 pprInstr (JMP reg addr hint)
786 ptext SLIT("\tjmp\t"),
795 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
797 pprInstr (JSR reg addr n)
799 ptext SLIT("\tjsr\t"),
805 pprInstr (FUNBEGIN clab)
807 if (externallyVisibleCLabel clab) then
808 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
811 ptext SLIT("\t.ent "),
820 pp_lab = pprCLabel_asm clab
822 pp_ldgp = ptext SLIT(":\n\tldgp $29,0($27)\n")
823 pp_frame = ptext SLIT("..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1")
825 pprInstr (FUNEND clab)
826 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
829 Continue with Alpha-only printing bits and bobs:
833 pprRI (RIReg r) = pprReg r
834 pprRI (RIImm r) = pprImm r
836 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
838 pprRegRIReg name reg1 ri reg2
850 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
852 pprSizeRegRegReg name size reg1 reg2 reg3
865 #endif {-alpha_TARGET_ARCH-}
868 %************************************************************************
870 \subsubsection{@pprInstr@ for an I386}
872 %************************************************************************
877 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
881 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
885 pprInstr (MOV size src dst)
886 = pprSizeOpOp SLIT("mov") size src dst
887 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
888 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
890 -- here we do some patching, since the physical registers are only set late
891 -- in the code generation.
892 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
894 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
895 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
897 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
898 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
900 = pprInstr (ADD size (OpImm displ) dst)
901 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
903 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
904 = pprSizeOp SLIT("dec") size dst
905 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
906 = pprSizeOp SLIT("inc") size dst
907 pprInstr (ADD size src dst)
908 = pprSizeOpOp SLIT("add") size src dst
909 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
910 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
911 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
913 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
914 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
915 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
916 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
917 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
919 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
920 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
921 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
923 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
924 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
925 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
926 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
928 pprInstr (NOP) = ptext SLIT("\tnop")
929 pprInstr (CLTD) = ptext SLIT("\tcltd")
931 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
933 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
935 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
936 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
939 = hcat [ ptext SLIT("\tcall "), pprImm imm ]
941 pprInstr SAHF = ptext SLIT("\tsahf")
942 pprInstr FABS = ptext SLIT("\tfabs")
944 pprInstr (FADD sz src@(OpAddr _))
945 = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
946 pprInstr (FADD sz src)
947 = ptext SLIT("\tfadd")
949 = ptext SLIT("\tfaddp")
950 pprInstr (FMUL sz src)
951 = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
953 = ptext SLIT("\tfmulp")
954 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
955 pprInstr FCHS = ptext SLIT("\tfchs")
956 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
957 pprInstr FCOS = ptext SLIT("\tfcos")
958 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
959 pprInstr (FDIV sz src)
960 = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
962 = ptext SLIT("\tfdivp")
963 pprInstr (FDIVR sz src)
964 = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
966 = ptext SLIT("\tfdivpr")
967 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
968 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
969 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
970 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
971 pprInstr (FLD sz (OpImm (ImmCLbl src)))
972 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
973 pprInstr (FLD sz src)
974 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
975 pprInstr FLD1 = ptext SLIT("\tfld1")
976 pprInstr FLDZ = ptext SLIT("\tfldz")
977 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
978 pprInstr FRNDINT = ptext SLIT("\tfrndint")
979 pprInstr FSIN = ptext SLIT("\tfsin")
980 pprInstr FSQRT = ptext SLIT("\tfsqrt")
981 pprInstr (FST sz dst)
982 = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
983 pprInstr (FSTP sz dst)
984 = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
985 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
986 pprInstr (FSUB sz src)
987 = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
989 = ptext SLIT("\tfsubp")
990 pprInstr (FSUBR size src)
991 = pprSizeOp SLIT("fsubr") size src
993 = ptext SLIT("\tfsubpr")
994 pprInstr (FISUBR size op)
995 = pprSizeAddr SLIT("fisubr") size op
996 pprInstr FTST = ptext SLIT("\tftst")
997 pprInstr (FCOMP sz op)
998 = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
999 pprInstr FUCOMPP = ptext SLIT("\tfucompp")
1000 pprInstr FXCH = ptext SLIT("\tfxch")
1001 pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
1002 pprInstr FNOP = ptext SLIT("")
1005 Continue with I386-only printing bits and bobs:
1007 pprDollImm :: Imm -> SDoc
1009 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1011 pprOperand :: Size -> Operand -> SDoc
1012 pprOperand s (OpReg r) = pprReg s r
1013 pprOperand s (OpImm i) = pprDollImm i
1014 pprOperand s (OpAddr ea) = pprAddr ea
1016 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1017 pprSizeOp name size op1
1026 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1027 pprSizeOpOp name size op1 op2
1033 pprOperand size op1,
1038 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1039 pprSizeByteOpOp name size op1 op2
1050 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1051 pprSizeOpReg name size op1 reg
1057 pprOperand size op1,
1062 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1063 pprSizeAddr name size op
1072 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1073 pprSizeAddrReg name size op dst
1084 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1085 pprOpOp name size op1 op2
1089 pprOperand size op1,
1094 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1095 pprSizeOpOpCoerce name size1 size2 op1 op2
1096 = hcat [ char '\t', ptext name, space,
1097 pprOperand size1 op1,
1099 pprOperand size2 op2
1102 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1103 pprCondInstr name cond arg
1104 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1106 #endif {-i386_TARGET_ARCH-}
1109 %************************************************************************
1111 \subsubsection{@pprInstr@ for a SPARC}
1113 %************************************************************************
1116 #if sparc_TARGET_ARCH
1118 -- a clumsy hack for now, to handle possible double alignment problems
1120 -- even clumsier, to allow for RegReg regs that show when doing indexed
1121 -- reads (bytearrays).
1123 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1125 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1126 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1127 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1130 pprInstr (LD DF addr reg) | maybeToBool off_addr
1144 off_addr = addrOffset addr 4
1145 addr2 = case off_addr of Just x -> x
1147 pprInstr (LD size addr reg)
1158 -- The same clumsy hack as above
1160 pprInstr (ST DF reg (AddrRegReg g1 g2))
1162 ptext SLIT("\tadd\t"),
1163 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1164 ptext SLIT("\tst\t"),
1165 pprReg reg, pp_comma_lbracket, pprReg g1,
1166 ptext SLIT("]\n\tst\t"),
1167 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1170 pprInstr (ST DF reg addr) | maybeToBool off_addr
1172 ptext SLIT("\tst\t"),
1173 pprReg reg, pp_comma_lbracket, pprAddr addr,
1175 ptext SLIT("]\n\tst\t"),
1176 pprReg (fPair reg), pp_comma_lbracket,
1177 pprAddr addr2, rbrack
1180 off_addr = addrOffset addr 4
1181 addr2 = case off_addr of Just x -> x
1183 -- no distinction is made between signed and unsigned bytes on stores for the
1184 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1185 -- so we call a special-purpose pprSize for ST..
1187 pprInstr (ST size reg addr)
1198 pprInstr (ADD x cc reg1 ri reg2)
1199 | not x && not cc && riZero ri
1200 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1202 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1204 pprInstr (SUB x cc reg1 ri reg2)
1205 | not x && cc && reg2 == g0
1206 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1207 | not x && not cc && riZero ri
1208 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1210 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1212 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1213 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1215 pprInstr (OR b reg1 ri reg2)
1216 | not b && reg1 == g0
1217 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1219 = pprRegRIReg SLIT("or") b reg1 ri reg2
1221 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1223 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1224 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1226 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1227 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1228 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1230 pprInstr (SETHI imm reg)
1232 ptext SLIT("\tsethi\t"),
1238 pprInstr NOP = ptext SLIT("\tnop")
1240 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1241 pprInstr (FABS DF reg1 reg2)
1242 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1243 (if (reg1 == reg2) then empty
1244 else (<>) (char '\n')
1245 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1247 pprInstr (FADD size reg1 reg2 reg3)
1248 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1249 pprInstr (FCMP e size reg1 reg2)
1250 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1251 pprInstr (FDIV size reg1 reg2 reg3)
1252 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1254 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1255 pprInstr (FMOV DF reg1 reg2)
1256 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1257 (if (reg1 == reg2) then empty
1258 else (<>) (char '\n')
1259 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1261 pprInstr (FMUL size reg1 reg2 reg3)
1262 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1264 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1265 pprInstr (FNEG DF reg1 reg2)
1266 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1267 (if (reg1 == reg2) then empty
1268 else (<>) (char '\n')
1269 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1271 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1272 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1273 pprInstr (FxTOy size1 size2 reg1 reg2)
1286 pprReg reg1, comma, pprReg reg2
1290 pprInstr (BI cond b lab)
1292 ptext SLIT("\tb"), pprCond cond,
1293 if b then pp_comma_a else empty,
1298 pprInstr (BF cond b lab)
1300 ptext SLIT("\tfb"), pprCond cond,
1301 if b then pp_comma_a else empty,
1306 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1308 pprInstr (CALL imm n _)
1309 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1312 Continue with SPARC-only printing bits and bobs:
1315 pprRI (RIReg r) = pprReg r
1316 pprRI (RIImm r) = pprImm r
1318 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1319 pprSizeRegReg name size reg1 reg2
1324 F -> ptext SLIT("s\t")
1325 DF -> ptext SLIT("d\t")),
1331 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1332 pprSizeRegRegReg name size reg1 reg2 reg3
1337 F -> ptext SLIT("s\t")
1338 DF -> ptext SLIT("d\t")),
1346 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1347 pprRegRIReg name b reg1 ri reg2
1351 if b then ptext SLIT("cc\t") else char '\t',
1359 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1360 pprRIReg name b ri reg1
1364 if b then ptext SLIT("cc\t") else char '\t',
1370 pp_ld_lbracket = ptext SLIT("\tld\t[")
1371 pp_rbracket_comma = text "],"
1372 pp_comma_lbracket = text ",["
1373 pp_comma_a = text ",a"
1375 #endif {-sparc_TARGET_ARCH-}