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 Ubiq{-uitious-}
18 import MachRegs -- may differ per-platform
21 import CLabel ( pprCLabel_asm, externallyVisibleCLabel )
22 import CStrings ( charToC )
23 import Maybes ( maybeToBool )
24 import OrdList ( OrdList )
25 import Stix ( CodeSegment(..), StixTree )
26 import Unpretty -- all of it
29 %************************************************************************
31 \subsection{@pprReg@: print a @Reg@}
33 %************************************************************************
35 For x86, the way we print a register name depends
36 on which bit of it we care about. Yurgh.
38 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Unpretty
40 pprReg IF_ARCH_i386(s,) r
42 FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
43 MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
44 other -> uppStr (show other) -- should only happen when debugging
47 ppr_reg_no :: FAST_REG_NO -> Unpretty
48 ppr_reg_no i = uppPStr
50 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
51 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
52 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
53 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
54 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
55 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
56 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
57 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
58 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
59 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
60 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
61 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
62 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
63 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
64 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
65 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
66 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
67 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
68 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
69 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
70 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
71 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
72 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
73 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
74 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
75 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
76 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
77 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
78 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
79 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
80 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
81 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
82 _ -> SLIT("very naughty alpha register")
86 ppr_reg_no :: Size -> FAST_REG_NO -> Unpretty
87 ppr_reg_no B i = uppPStr
89 ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl");
90 ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl");
91 _ -> SLIT("very naughty I386 byte register")
95 ppr_reg_no HB i = uppPStr
97 ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh");
98 ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh");
99 _ -> SLIT("very naughty I386 high byte register")
104 ppr_reg_no S i = uppPStr
106 ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx");
107 ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx");
108 ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
109 ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
110 _ -> SLIT("very naughty I386 word register")
114 ppr_reg_no L i = uppPStr
116 ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
117 ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
118 ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
119 ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
120 _ -> SLIT("very naughty I386 double word register")
123 ppr_reg_no F i = uppPStr
125 --ToDo: rm these (???)
126 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
127 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
128 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
129 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
130 _ -> SLIT("very naughty I386 float register")
133 ppr_reg_no DF i = uppPStr
135 --ToDo: rm these (???)
136 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
137 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
138 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
139 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
140 _ -> SLIT("very naughty I386 float register")
143 #if sparc_TARGET_ARCH
144 ppr_reg_no :: FAST_REG_NO -> Unpretty
145 ppr_reg_no i = uppPStr
147 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
148 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
149 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
150 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
151 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
152 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
153 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
154 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
155 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
156 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
157 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
158 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
159 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
160 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
161 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
162 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
163 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
164 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
165 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
166 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
167 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
168 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
169 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
170 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
171 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
172 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
173 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
174 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
175 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
176 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
177 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
178 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
179 _ -> SLIT("very naughty sparc register")
184 %************************************************************************
186 \subsection{@pprSize@: print a @Size@}
188 %************************************************************************
191 pprSize :: Size -> Unpretty
193 pprSize x = uppPStr (case x of
194 #if alpha_TARGET_ARCH
197 -- W -> SLIT("w") UNUSED
198 -- WU -> SLIT("wu") UNUSED
199 -- L -> SLIT("l") UNUSED
201 -- FF -> SLIT("f") UNUSED
202 -- DF -> SLIT("d") UNUSED
203 -- GF -> SLIT("g") UNUSED
204 -- SF -> SLIT("s") UNUSED
209 -- HB -> SLIT("b") UNUSED
210 -- S -> SLIT("w") UNUSED
215 #if sparc_TARGET_ARCH
217 -- HW -> SLIT("hw") UNUSED
218 -- BU -> SLIT("ub") UNUSED
219 -- HWU -> SLIT("uhw") UNUSED
222 -- D -> SLIT("d") UNUSED
228 %************************************************************************
230 \subsection{@pprCond@: print a @Cond@}
232 %************************************************************************
235 pprCond :: Cond -> Unpretty
237 pprCond c = uppPStr (case c of {
238 #if alpha_TARGET_ARCH
249 GEU -> SLIT("ae"); LU -> SLIT("b");
250 EQ -> SLIT("e"); GT -> SLIT("g");
251 GE -> SLIT("ge"); GU -> SLIT("a");
252 LT -> SLIT("l"); LE -> SLIT("le");
253 LEU -> SLIT("be"); NE -> SLIT("ne");
254 NEG -> SLIT("s"); POS -> SLIT("ns");
255 ALWAYS -> SLIT("mp") -- hack
257 #if sparc_TARGET_ARCH
258 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
259 GEU -> SLIT("geu"); LU -> SLIT("lu");
260 EQ -> SLIT("e"); GT -> SLIT("g");
261 GE -> SLIT("ge"); GU -> SLIT("gu");
262 LT -> SLIT("l"); LE -> SLIT("le");
263 LEU -> SLIT("leu"); NE -> SLIT("ne");
264 NEG -> SLIT("neg"); POS -> SLIT("pos");
265 VC -> SLIT("vc"); VS -> SLIT("vs")
270 %************************************************************************
272 \subsection{@pprImm@: print an @Imm@}
274 %************************************************************************
277 pprImm :: Imm -> Unpretty
279 pprImm (ImmInt i) = uppInt i
280 pprImm (ImmInteger i) = uppInteger i
281 pprImm (ImmCLbl l) = pprCLabel_asm l
282 pprImm (ImmLit s) = s
284 pprImm (ImmLab s) | underscorePrefix = uppBeside (uppChar '_') s
287 #if sparc_TARGET_ARCH
289 = uppBesides [ pp_lo, pprImm i, uppRparen ]
291 pp_lo = uppPStr (_packCString (A# "%lo("#))
294 = uppBesides [ pp_hi, pprImm i, uppRparen ]
296 pp_hi = uppPStr (_packCString (A# "%hi("#))
300 %************************************************************************
302 \subsection{@pprAddr@: print an @Addr@}
304 %************************************************************************
307 pprAddr :: Addr -> Unpretty
309 #if alpha_TARGET_ARCH
310 pprAddr (AddrReg r) = uppParens (pprReg r)
311 pprAddr (AddrImm i) = pprImm i
312 pprAddr (AddrRegImm r1 i)
313 = uppBeside (pprImm i) (uppParens (pprReg r1))
319 pprAddr (ImmAddr imm off)
325 else if (off < 0) then
326 uppBeside pp_imm (uppInt off)
328 uppBesides [pp_imm, uppChar '+', uppInt off]
330 pprAddr (Addr base index displacement)
332 pp_disp = ppr_disp displacement
333 pp_off p = uppBeside pp_disp (uppParens p)
334 pp_reg r = pprReg L r
337 (Nothing, Nothing) -> pp_disp
338 (Just b, Nothing) -> pp_off (pp_reg b)
339 (Nothing, Just (r,i)) -> pp_off (uppBesides [pp_reg r, uppComma, uppInt i])
340 (Just b, Just (r,i)) -> pp_off (uppBesides [pp_reg b, uppComma, pp_reg r, uppComma, uppInt i])
342 ppr_disp (ImmInt 0) = uppNil
343 ppr_disp imm = pprImm imm
348 #if sparc_TARGET_ARCH
349 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
351 pprAddr (AddrRegReg r1 r2)
352 = uppBesides [ pprReg r1, uppChar '+', pprReg r2 ]
354 pprAddr (AddrRegImm r1 (ImmInt i))
356 | not (fits13Bits i) = largeOffsetError i
357 | otherwise = uppBesides [ pprReg r1, pp_sign, uppInt i ]
359 pp_sign = if i > 0 then uppChar '+' else uppNil
361 pprAddr (AddrRegImm r1 (ImmInteger i))
363 | not (fits13Bits i) = largeOffsetError i
364 | otherwise = uppBesides [ pprReg r1, pp_sign, uppInteger i ]
366 pp_sign = if i > 0 then uppChar '+' else uppNil
368 pprAddr (AddrRegImm r1 imm)
369 = uppBesides [ pprReg r1, uppChar '+', pprImm imm ]
373 %************************************************************************
375 \subsection{@pprInstr@: print an @Instr@}
377 %************************************************************************
380 pprInstr :: Instr -> Unpretty
382 pprInstr (COMMENT s) = uppBeside (uppPStr SLIT("\t# ")) (uppPStr s)
384 pprInstr (SEGMENT TextSegment)
386 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
387 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
388 ,IF_ARCH_i386(SLIT(".text\n\t.align 2,0x90") {-needs per-OS variation!-}
391 pprInstr (SEGMENT DataSegment)
393 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
394 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
395 ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
398 pprInstr (LABEL clab)
400 pp_lab = pprCLabel_asm clab
403 if not (externallyVisibleCLabel clab) then
407 IF_ARCH_alpha(SLIT("\t.globl\t")
408 ,IF_ARCH_i386(SLIT(".globl ")
409 ,IF_ARCH_sparc(SLIT("\t.global\t")
411 , pp_lab, uppChar '\n'],
416 pprInstr (ASCII False{-no backslash conversion-} str)
417 = uppBesides [ uppStr "\t.asciz \"", uppStr str, uppChar '"' ]
419 pprInstr (ASCII True str)
420 = uppBeside (uppStr "\t.ascii \"") (asciify str 60)
422 asciify :: String -> Int -> Unpretty
424 asciify [] _ = uppStr ("\\0\"")
425 asciify s n | n <= 0 = uppBeside (uppStr "\"\n\t.ascii \"") (asciify s 60)
426 asciify ('\\':cs) n = uppBeside (uppStr "\\\\") (asciify cs (n-1))
427 asciify ('\"':cs) n = uppBeside (uppStr "\\\"") (asciify cs (n-1))
428 asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1))
429 asciify [c] _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\""))
430 asciify (c:(cs@(d:_))) n
431 | isDigit d = uppBeside (uppStr (charToC c)) (asciify cs 0)
432 | otherwise = uppBeside (uppStr (charToC c)) (asciify cs (n-1))
435 = uppInterleave (uppChar '\n')
436 [uppBeside (uppPStr pp_size) (pprImm x) | x <- xs]
439 #if alpha_TARGET_ARCH
440 B -> SLIT("\t.byte\t")
441 BU -> SLIT("\t.byte\t")
442 --UNUSED: W -> SLIT("\t.word\t")
443 --UNUSED: WU -> SLIT("\t.word\t")
444 --UNUSED: L -> SLIT("\t.long\t")
445 Q -> SLIT("\t.quad\t")
446 --UNUSED: FF -> SLIT("\t.f_floating\t")
447 --UNUSED: DF -> SLIT("\t.d_floating\t")
448 --UNUSED: GF -> SLIT("\t.g_floating\t")
449 --UNUSED: SF -> SLIT("\t.s_floating\t")
450 TF -> SLIT("\t.t_floating\t")
453 B -> SLIT("\t.byte\t")
454 --UNUSED: HB -> SLIT("\t.byte\t")
455 --UNUSED: S -> SLIT("\t.word\t")
456 L -> SLIT("\t.long\t")
457 F -> SLIT("\t.long\t")
458 DF -> SLIT("\t.double\t")
460 #if sparc_TARGET_ARCH
461 B -> SLIT("\t.byte\t")
462 BU -> SLIT("\t.byte\t")
463 W -> SLIT("\t.word\t")
464 DF -> SLIT("\t.double\t")
467 -- fall through to rest of (machine-specific) pprInstr...
470 %************************************************************************
472 \subsubsection{@pprInstr@ for an Alpha}
474 %************************************************************************
477 #if alpha_TARGET_ARCH
479 pprInstr (LD size reg addr)
481 uppPStr SLIT("\tld"),
489 pprInstr (LDA reg addr)
491 uppPStr SLIT("\tlda\t"),
497 pprInstr (LDAH reg addr)
499 uppPStr SLIT("\tldah\t"),
505 pprInstr (LDGP reg addr)
507 uppPStr SLIT("\tldgp\t"),
513 pprInstr (LDI size reg imm)
515 uppPStr SLIT("\tldi"),
523 pprInstr (ST size reg addr)
525 uppPStr SLIT("\tst"),
535 uppPStr SLIT("\tclr\t"),
539 pprInstr (ABS size ri reg)
541 uppPStr SLIT("\tabs"),
549 pprInstr (NEG size ov ri reg)
551 uppPStr SLIT("\tneg"),
553 if ov then uppPStr SLIT("v\t") else uppChar '\t',
559 pprInstr (ADD size ov reg1 ri reg2)
561 uppPStr SLIT("\tadd"),
563 if ov then uppPStr SLIT("v\t") else uppChar '\t',
571 pprInstr (SADD size scale reg1 ri reg2)
573 uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
584 pprInstr (SUB size ov reg1 ri reg2)
586 uppPStr SLIT("\tsub"),
588 if ov then uppPStr SLIT("v\t") else uppChar '\t',
596 pprInstr (SSUB size scale reg1 ri reg2)
598 uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
609 pprInstr (MUL size ov reg1 ri reg2)
611 uppPStr SLIT("\tmul"),
613 if ov then uppPStr SLIT("v\t") else uppChar '\t',
621 pprInstr (DIV size uns reg1 ri reg2)
623 uppPStr SLIT("\tdiv"),
625 if uns then uppPStr SLIT("u\t") else uppChar '\t',
633 pprInstr (REM size uns reg1 ri reg2)
635 uppPStr SLIT("\trem"),
637 if uns then uppPStr SLIT("u\t") else uppChar '\t',
645 pprInstr (NOT ri reg)
647 uppPStr SLIT("\tnot"),
654 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
655 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
656 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
657 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
658 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
659 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
661 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
662 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
663 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
665 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
666 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
668 pprInstr (NOP) = uppPStr SLIT("\tnop")
670 pprInstr (CMP cond reg1 ri reg2)
672 uppPStr SLIT("\tcmp"),
684 uppPStr SLIT("\tfclr\t"),
688 pprInstr (FABS reg1 reg2)
690 uppPStr SLIT("\tfabs\t"),
696 pprInstr (FNEG size reg1 reg2)
698 uppPStr SLIT("\tneg"),
706 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
707 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
708 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
709 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
711 pprInstr (CVTxy size1 size2 reg1 reg2)
713 uppPStr SLIT("\tcvt"),
715 case size2 of {Q -> uppPStr SLIT("qc"); _ -> pprSize size2},
722 pprInstr (FCMP size cond reg1 reg2 reg3)
724 uppPStr SLIT("\tcmp"),
735 pprInstr (FMOV reg1 reg2)
737 uppPStr SLIT("\tfmov\t"),
743 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
745 pprInstr (BI NEVER reg lab) = uppNil
747 pprInstr (BI cond reg lab)
757 pprInstr (BF cond reg lab)
759 uppPStr SLIT("\tfb"),
768 = uppBeside (uppPStr SLIT("\tbr\t")) (pprImm lab)
770 pprInstr (JMP reg addr hint)
772 uppPStr SLIT("\tjmp\t"),
781 = uppBeside (uppPStr SLIT("\tbsr\t")) (pprImm imm)
783 pprInstr (JSR reg addr n)
785 uppPStr SLIT("\tjsr\t"),
791 pprInstr (FUNBEGIN clab)
793 if (externallyVisibleCLabel clab) then
794 uppBesides [uppPStr SLIT("\t.globl\t"), pp_lab, uppChar '\n']
797 uppPStr SLIT("\t.ent "),
806 pp_lab = pprCLabel_asm clab
807 pp_ldgp = uppPStr (_packCString (A# ":\n\tldgp $29,0($27)\n"#))
808 pp_frame = uppPStr (_packCString (A# "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#))
810 pprInstr (FUNEND clab)
811 = uppBeside (uppPStr SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
814 Continue with Alpha-only printing bits and bobs:
816 pprRI :: RI -> Unpretty
818 pprRI (RIReg r) = pprReg r
819 pprRI (RIImm r) = pprImm r
821 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Unpretty
823 pprRegRIReg name reg1 ri reg2
835 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
837 pprSizeRegRegReg name size reg1 reg2 reg3
850 #endif {-alpha_TARGET_ARCH-}
853 %************************************************************************
855 \subsubsection{@pprInstr@ for an I386}
857 %************************************************************************
862 pprInstr (MOV size (OpReg src) (OpReg dst)) -- hack
865 pprInstr (MOV size src dst)
866 = pprSizeOpOp SLIT("mov") size src dst
867 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
868 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
870 -- here we do some patching, since the physical registers are only set late
871 -- in the code generation.
872 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
874 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
875 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
877 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
878 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
880 = pprInstr (ADD size (OpImm displ) dst)
881 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
883 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
884 = pprSizeOp SLIT("dec") size dst
885 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
886 = pprSizeOp SLIT("inc") size dst
887 pprInstr (ADD size src dst)
888 = pprSizeOpOp SLIT("add") size src dst
889 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
890 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
891 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
893 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
894 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
895 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
896 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
897 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
898 pprInstr (SHL size imm dst) = pprSizeOpOp SLIT("shl") size imm dst
899 pprInstr (SAR size imm dst) = pprSizeOpOp SLIT("sar") size imm dst
900 pprInstr (SHR size imm dst) = pprSizeOpOp SLIT("shr") size imm dst
902 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
903 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
904 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
905 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
907 pprInstr (NOP) = uppPStr SLIT("\tnop")
908 pprInstr (CLTD) = uppPStr SLIT("\tcltd")
910 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
912 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
914 pprInstr (JMP (OpImm imm)) = uppBeside (uppPStr SLIT("\tjmp ")) (pprImm imm)
915 pprInstr (JMP op) = uppBeside (uppPStr SLIT("\tjmp *")) (pprOperand L op)
918 = uppBesides [ uppPStr SLIT("\tcall "), pprImm imm ]
920 pprInstr SAHF = uppPStr SLIT("\tsahf")
921 pprInstr FABS = uppPStr SLIT("\tfabs")
923 pprInstr (FADD sz src@(OpAddr _))
924 = uppBesides [uppPStr SLIT("\tfadd"), pprSize sz, uppSP, pprOperand sz src]
925 pprInstr (FADD sz src)
926 = uppPStr SLIT("\tfadd")
928 = uppPStr SLIT("\tfaddp")
929 pprInstr (FMUL sz src)
930 = uppBesides [uppPStr SLIT("\tfmul"), pprSize sz, uppSP, pprOperand sz src]
932 = uppPStr SLIT("\tfmulp")
933 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
934 pprInstr FCHS = uppPStr SLIT("\tfchs")
935 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
936 pprInstr FCOS = uppPStr SLIT("\tfcos")
937 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
938 pprInstr (FDIV sz src)
939 = uppBesides [uppPStr SLIT("\tfdiv"), pprSize sz, uppSP, pprOperand sz src]
941 = uppPStr SLIT("\tfdivp")
942 pprInstr (FDIVR sz src)
943 = uppBesides [uppPStr SLIT("\tfdivr"), pprSize sz, uppSP, pprOperand sz src]
945 = uppPStr SLIT("\tfdivpr")
946 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
947 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
948 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
949 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
950 pprInstr (FLD sz (OpImm (ImmCLbl src)))
951 = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprCLabel_asm src]
952 pprInstr (FLD sz src)
953 = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprOperand sz src]
954 pprInstr FLD1 = uppPStr SLIT("\tfld1")
955 pprInstr FLDZ = uppPStr SLIT("\tfldz")
956 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
957 pprInstr FRNDINT = uppPStr SLIT("\tfrndint")
958 pprInstr FSIN = uppPStr SLIT("\tfsin")
959 pprInstr FSQRT = uppPStr SLIT("\tfsqrt")
960 pprInstr (FST sz dst)
961 = uppBesides [uppPStr SLIT("\tfst"), pprSize sz, uppSP, pprOperand sz dst]
962 pprInstr (FSTP sz dst)
963 = uppBesides [uppPStr SLIT("\tfstp"), pprSize sz, uppSP, pprOperand sz dst]
964 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
965 pprInstr (FSUB sz src)
966 = uppBesides [uppPStr SLIT("\tfsub"), pprSize sz, uppSP, pprOperand sz src]
968 = uppPStr SLIT("\tfsubp")
969 pprInstr (FSUBR size src)
970 = pprSizeOp SLIT("fsubr") size src
972 = uppPStr SLIT("\tfsubpr")
973 pprInstr (FISUBR size op)
974 = pprSizeAddr SLIT("fisubr") size op
975 pprInstr FTST = uppPStr SLIT("\tftst")
976 pprInstr (FCOMP sz op)
977 = uppBesides [uppPStr SLIT("\tfcomp"), pprSize sz, uppSP, pprOperand sz op]
978 pprInstr FUCOMPP = uppPStr SLIT("\tfucompp")
979 pprInstr FXCH = uppPStr SLIT("\tfxch")
980 pprInstr FNSTSW = uppPStr SLIT("\tfnstsw %ax")
981 pprInstr FNOP = uppPStr SLIT("")
984 Continue with I386-only printing bits and bobs:
986 pprDollImm :: Imm -> Unpretty
988 pprDollImm i = uppBesides [ uppPStr SLIT("$"), pprImm i]
990 pprOperand :: Size -> Operand -> Unpretty
991 pprOperand s (OpReg r) = pprReg s r
992 pprOperand s (OpImm i) = pprDollImm i
993 pprOperand s (OpAddr ea) = pprAddr ea
995 pprSizeOp :: FAST_STRING -> Size -> Operand -> Unpretty
996 pprSizeOp name size op1
1005 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty
1006 pprSizeOpOp name size op1 op2
1012 pprOperand size op1,
1017 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Unpretty
1018 pprSizeOpReg name size op1 reg
1024 pprOperand size op1,
1029 pprSizeAddr :: FAST_STRING -> Size -> Addr -> Unpretty
1030 pprSizeAddr name size op
1039 pprSizeAddrReg :: FAST_STRING -> Size -> Addr -> Reg -> Unpretty
1040 pprSizeAddrReg name size op dst
1051 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty
1052 pprOpOp name size op1 op2
1055 uppPStr name, uppSP,
1056 pprOperand size op1,
1061 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Unpretty
1062 pprSizeOpOpCoerce name size1 size2 op1 op2
1063 = uppBesides [ uppChar '\t', uppPStr name, uppSP,
1064 pprOperand size1 op1,
1066 pprOperand size2 op2
1069 pprCondInstr :: FAST_STRING -> Cond -> Unpretty -> Unpretty
1070 pprCondInstr name cond arg
1071 = uppBesides [ uppChar '\t', uppPStr name, pprCond cond, uppSP, arg]
1073 #endif {-i386_TARGET_ARCH-}
1076 %************************************************************************
1078 \subsubsection{@pprInstr@ for a SPARC}
1080 %************************************************************************
1083 #if sparc_TARGET_ARCH
1085 -- a clumsy hack for now, to handle possible double alignment problems
1087 pprInstr (LD DF addr reg) | maybeToBool off_addr
1101 off_addr = addrOffset addr 4
1102 addr2 = case off_addr of Just x -> x
1104 pprInstr (LD size addr reg)
1106 uppPStr SLIT("\tld"),
1115 -- The same clumsy hack as above
1117 pprInstr (ST DF reg addr) | maybeToBool off_addr
1119 uppPStr SLIT("\tst\t"),
1124 uppPStr SLIT("]\n\tst\t"),
1131 off_addr = addrOffset addr 4
1132 addr2 = case off_addr of Just x -> x
1134 pprInstr (ST size reg addr)
1136 uppPStr SLIT("\tst"),
1145 pprInstr (ADD x cc reg1 ri reg2)
1146 | not x && not cc && riZero ri
1147 = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ]
1149 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1151 pprInstr (SUB x cc reg1 ri reg2)
1152 | not x && cc && reg2 == g0
1153 = uppBesides [ uppPStr SLIT("\tcmp\t"), pprReg reg1, uppComma, pprRI ri ]
1154 | not x && not cc && riZero ri
1155 = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ]
1157 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1159 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1160 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1162 pprInstr (OR b reg1 ri reg2)
1163 | not b && reg1 == g0
1164 = uppBesides [ uppPStr SLIT("\tmov\t"), pprRI ri, uppComma, pprReg reg2 ]
1166 = pprRegRIReg SLIT("or") b reg1 ri reg2
1168 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1170 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1171 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1173 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1174 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1175 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1177 pprInstr (SETHI imm reg)
1179 uppPStr SLIT("\tsethi\t"),
1185 pprInstr NOP = uppPStr SLIT("\tnop")
1187 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1188 pprInstr (FABS DF reg1 reg2)
1189 = uppBeside (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1190 (if (reg1 == reg2) then uppNil
1191 else uppBeside (uppChar '\n')
1192 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1194 pprInstr (FADD size reg1 reg2 reg3)
1195 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1196 pprInstr (FCMP e size reg1 reg2)
1197 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1198 pprInstr (FDIV size reg1 reg2 reg3)
1199 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1201 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1202 pprInstr (FMOV DF reg1 reg2)
1203 = uppBeside (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1204 (if (reg1 == reg2) then uppNil
1205 else uppBeside (uppChar '\n')
1206 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1208 pprInstr (FMUL size reg1 reg2 reg3)
1209 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1211 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1212 pprInstr (FNEG DF reg1 reg2)
1213 = uppBeside (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1214 (if (reg1 == reg2) then uppNil
1215 else uppBeside (uppChar '\n')
1216 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1218 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1219 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1220 pprInstr (FxTOy size1 size2 reg1 reg2)
1222 uppPStr SLIT("\tf"),
1233 pprReg reg1, uppComma, pprReg reg2
1237 pprInstr (BI cond b lab)
1239 uppPStr SLIT("\tb"), pprCond cond,
1240 if b then pp_comma_a else uppNil,
1245 pprInstr (BF cond b lab)
1247 uppPStr SLIT("\tfb"), pprCond cond,
1248 if b then pp_comma_a else uppNil,
1253 pprInstr (JMP addr) = uppBeside (uppPStr SLIT("\tjmp\t")) (pprAddr addr)
1255 pprInstr (CALL imm n _)
1256 = uppBesides [ uppPStr SLIT("\tcall\t"), pprImm imm, uppComma, uppInt n ]
1259 Continue with SPARC-only printing bits and bobs:
1261 pprRI :: RI -> Unpretty
1262 pprRI (RIReg r) = pprReg r
1263 pprRI (RIImm r) = pprImm r
1265 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Unpretty
1266 pprSizeRegReg name size reg1 reg2
1271 F -> uppPStr SLIT("s\t")
1272 DF -> uppPStr SLIT("d\t")),
1278 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
1279 pprSizeRegRegReg name size reg1 reg2 reg3
1284 F -> uppPStr SLIT("s\t")
1285 DF -> uppPStr SLIT("d\t")),
1293 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Unpretty
1294 pprRegRIReg name b reg1 ri reg2
1298 if b then uppPStr SLIT("cc\t") else uppChar '\t',
1306 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Unpretty
1307 pprRIReg name b ri reg1
1311 if b then uppPStr SLIT("cc\t") else uppChar '\t',
1317 pp_ld_lbracket = uppPStr (_packCString (A# "\tld\t["#))
1318 pp_rbracket_comma = uppPStr (_packCString (A# "],"#))
1319 pp_comma_lbracket = uppPStr (_packCString (A# ",["#))
1320 pp_comma_a = uppPStr (_packCString (A# ",a"#))
1322 #endif {-sparc_TARGET_ARCH-}