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 -- NEVER use commas within those string literals, cpp will ruin your day
823 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
824 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
825 ptext SLIT("4240"), char ',',
826 ptext SLIT("$26"), char ',',
827 ptext SLIT("0\n\t.prologue 1") ]
829 pprInstr (FUNEND clab)
830 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
833 Continue with Alpha-only printing bits and bobs:
837 pprRI (RIReg r) = pprReg r
838 pprRI (RIImm r) = pprImm r
840 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
842 pprRegRIReg name reg1 ri reg2
854 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
856 pprSizeRegRegReg name size reg1 reg2 reg3
869 #endif {-alpha_TARGET_ARCH-}
872 %************************************************************************
874 \subsubsection{@pprInstr@ for an I386}
876 %************************************************************************
881 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
885 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
889 pprInstr (MOV size src dst)
890 = pprSizeOpOp SLIT("mov") size src dst
891 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
892 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
894 -- here we do some patching, since the physical registers are only set late
895 -- in the code generation.
896 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
898 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
899 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
901 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
902 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
904 = pprInstr (ADD size (OpImm displ) dst)
905 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
907 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
908 = pprSizeOp SLIT("dec") size dst
909 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
910 = pprSizeOp SLIT("inc") size dst
911 pprInstr (ADD size src dst)
912 = pprSizeOpOp SLIT("add") size src dst
913 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
914 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
915 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
917 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
918 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
919 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
920 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
921 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
923 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
924 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
925 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
927 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
928 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
929 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
930 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
932 pprInstr (NOP) = ptext SLIT("\tnop")
933 pprInstr (CLTD) = ptext SLIT("\tcltd")
935 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
937 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
939 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
940 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
943 = hcat [ ptext SLIT("\tcall "), pprImm imm ]
945 pprInstr SAHF = ptext SLIT("\tsahf")
946 pprInstr FABS = ptext SLIT("\tfabs")
948 pprInstr (FADD sz src@(OpAddr _))
949 = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
950 pprInstr (FADD sz src)
951 = ptext SLIT("\tfadd")
953 = ptext SLIT("\tfaddp")
954 pprInstr (FMUL sz src)
955 = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
957 = ptext SLIT("\tfmulp")
958 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
959 pprInstr FCHS = ptext SLIT("\tfchs")
960 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
961 pprInstr FCOS = ptext SLIT("\tfcos")
962 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
963 pprInstr (FDIV sz src)
964 = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
966 = ptext SLIT("\tfdivp")
967 pprInstr (FDIVR sz src)
968 = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
970 = ptext SLIT("\tfdivpr")
971 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
972 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
973 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
974 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
975 pprInstr (FLD sz (OpImm (ImmCLbl src)))
976 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
977 pprInstr (FLD sz src)
978 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
979 pprInstr FLD1 = ptext SLIT("\tfld1")
980 pprInstr FLDZ = ptext SLIT("\tfldz")
981 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
982 pprInstr FRNDINT = ptext SLIT("\tfrndint")
983 pprInstr FSIN = ptext SLIT("\tfsin")
984 pprInstr FSQRT = ptext SLIT("\tfsqrt")
985 pprInstr (FST sz dst)
986 = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
987 pprInstr (FSTP sz dst)
988 = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
989 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
990 pprInstr (FSUB sz src)
991 = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
993 = ptext SLIT("\tfsubp")
994 pprInstr (FSUBR size src)
995 = pprSizeOp SLIT("fsubr") size src
997 = ptext SLIT("\tfsubpr")
998 pprInstr (FISUBR size op)
999 = pprSizeAddr SLIT("fisubr") size op
1000 pprInstr FTST = ptext SLIT("\tftst")
1001 pprInstr (FCOMP sz op)
1002 = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
1003 pprInstr FUCOMPP = ptext SLIT("\tfucompp")
1004 pprInstr FXCH = ptext SLIT("\tfxch")
1005 pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
1006 pprInstr FNOP = ptext SLIT("")
1009 Continue with I386-only printing bits and bobs:
1011 pprDollImm :: Imm -> SDoc
1013 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1015 pprOperand :: Size -> Operand -> SDoc
1016 pprOperand s (OpReg r) = pprReg s r
1017 pprOperand s (OpImm i) = pprDollImm i
1018 pprOperand s (OpAddr ea) = pprAddr ea
1020 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1021 pprSizeOp name size op1
1030 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1031 pprSizeOpOp name size op1 op2
1037 pprOperand size op1,
1042 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1043 pprSizeByteOpOp name size op1 op2
1054 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1055 pprSizeOpReg name size op1 reg
1061 pprOperand size op1,
1066 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1067 pprSizeAddr name size op
1076 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1077 pprSizeAddrReg name size op dst
1088 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1089 pprOpOp name size op1 op2
1093 pprOperand size op1,
1098 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1099 pprSizeOpOpCoerce name size1 size2 op1 op2
1100 = hcat [ char '\t', ptext name, space,
1101 pprOperand size1 op1,
1103 pprOperand size2 op2
1106 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1107 pprCondInstr name cond arg
1108 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1110 #endif {-i386_TARGET_ARCH-}
1113 %************************************************************************
1115 \subsubsection{@pprInstr@ for a SPARC}
1117 %************************************************************************
1120 #if sparc_TARGET_ARCH
1122 -- a clumsy hack for now, to handle possible double alignment problems
1124 -- even clumsier, to allow for RegReg regs that show when doing indexed
1125 -- reads (bytearrays).
1127 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1129 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1130 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1131 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1134 pprInstr (LD DF addr reg) | maybeToBool off_addr
1148 off_addr = addrOffset addr 4
1149 addr2 = case off_addr of Just x -> x
1151 pprInstr (LD size addr reg)
1162 -- The same clumsy hack as above
1164 pprInstr (ST DF reg (AddrRegReg g1 g2))
1166 ptext SLIT("\tadd\t"),
1167 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1168 ptext SLIT("\tst\t"),
1169 pprReg reg, pp_comma_lbracket, pprReg g1,
1170 ptext SLIT("]\n\tst\t"),
1171 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1174 pprInstr (ST DF reg addr) | maybeToBool off_addr
1176 ptext SLIT("\tst\t"),
1177 pprReg reg, pp_comma_lbracket, pprAddr addr,
1179 ptext SLIT("]\n\tst\t"),
1180 pprReg (fPair reg), pp_comma_lbracket,
1181 pprAddr addr2, rbrack
1184 off_addr = addrOffset addr 4
1185 addr2 = case off_addr of Just x -> x
1187 -- no distinction is made between signed and unsigned bytes on stores for the
1188 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1189 -- so we call a special-purpose pprSize for ST..
1191 pprInstr (ST size reg addr)
1202 pprInstr (ADD x cc reg1 ri reg2)
1203 | not x && not cc && riZero ri
1204 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1206 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1208 pprInstr (SUB x cc reg1 ri reg2)
1209 | not x && cc && reg2 == g0
1210 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1211 | not x && not cc && riZero ri
1212 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1214 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1216 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1217 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1219 pprInstr (OR b reg1 ri reg2)
1220 | not b && reg1 == g0
1221 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1223 = pprRegRIReg SLIT("or") b reg1 ri reg2
1225 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1227 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1228 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1230 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1231 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1232 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1234 pprInstr (SETHI imm reg)
1236 ptext SLIT("\tsethi\t"),
1242 pprInstr NOP = ptext SLIT("\tnop")
1244 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1245 pprInstr (FABS DF reg1 reg2)
1246 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1247 (if (reg1 == reg2) then empty
1248 else (<>) (char '\n')
1249 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1251 pprInstr (FADD size reg1 reg2 reg3)
1252 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1253 pprInstr (FCMP e size reg1 reg2)
1254 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1255 pprInstr (FDIV size reg1 reg2 reg3)
1256 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1258 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1259 pprInstr (FMOV DF reg1 reg2)
1260 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1261 (if (reg1 == reg2) then empty
1262 else (<>) (char '\n')
1263 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1265 pprInstr (FMUL size reg1 reg2 reg3)
1266 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1268 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1269 pprInstr (FNEG DF reg1 reg2)
1270 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1271 (if (reg1 == reg2) then empty
1272 else (<>) (char '\n')
1273 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1275 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1276 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1277 pprInstr (FxTOy size1 size2 reg1 reg2)
1290 pprReg reg1, comma, pprReg reg2
1294 pprInstr (BI cond b lab)
1296 ptext SLIT("\tb"), pprCond cond,
1297 if b then pp_comma_a else empty,
1302 pprInstr (BF cond b lab)
1304 ptext SLIT("\tfb"), pprCond cond,
1305 if b then pp_comma_a else empty,
1310 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1312 pprInstr (CALL imm n _)
1313 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1316 Continue with SPARC-only printing bits and bobs:
1319 pprRI (RIReg r) = pprReg r
1320 pprRI (RIImm r) = pprImm r
1322 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1323 pprSizeRegReg name size reg1 reg2
1328 F -> ptext SLIT("s\t")
1329 DF -> ptext SLIT("d\t")),
1335 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1336 pprSizeRegRegReg name size reg1 reg2 reg3
1341 F -> ptext SLIT("s\t")
1342 DF -> ptext SLIT("d\t")),
1350 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1351 pprRegRIReg name b reg1 ri reg2
1355 if b then ptext SLIT("cc\t") else char '\t',
1363 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1364 pprRIReg name b ri reg1
1368 if b then ptext SLIT("cc\t") else char '\t',
1374 pp_ld_lbracket = ptext SLIT("\tld\t[")
1375 pp_rbracket_comma = text "],"
1376 pp_comma_lbracket = text ",["
1377 pp_comma_a = text ",a"
1379 #endif {-sparc_TARGET_ARCH-}