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
17 IMPORT_1_3(Char(isPrint,isDigit))
18 IMPORT_1_3(qualified GHCbase(Addr(..))) -- to see innards
20 import MachRegs -- may differ per-platform
23 import AbsCSyn ( MagicId )
24 import CLabel ( pprCLabel_asm, externallyVisibleCLabel )
25 import CStrings ( charToC )
26 import Maybes ( maybeToBool )
27 import OrdList ( OrdList )
28 import Stix ( CodeSegment(..), StixTree )
29 import Unpretty -- all of it
31 #if __GLASGOW_HASKELL__ >= 200
32 a_HASH x = GHCbase.A# x
33 pACK_STR x = packCString x
36 pACK_STR x = mkFastCharString x --_packCString x
40 %************************************************************************
42 \subsection{@pprReg@: print a @Reg@}
44 %************************************************************************
46 For x86, the way we print a register name depends
47 on which bit of it we care about. Yurgh.
49 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Unpretty
51 pprReg IF_ARCH_i386(s,) r
53 FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
54 MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
55 other -> uppStr (show other) -- should only happen when debugging
58 ppr_reg_no :: FAST_REG_NO -> Unpretty
59 ppr_reg_no i = uppPStr
61 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
62 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
63 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
64 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
65 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
66 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
67 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
68 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
69 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
70 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
71 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
72 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
73 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
74 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
75 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
76 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
77 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
78 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
79 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
80 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
81 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
82 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
83 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
84 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
85 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
86 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
87 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
88 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
89 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
90 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
91 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
92 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
93 _ -> SLIT("very naughty alpha register")
97 ppr_reg_no :: Size -> FAST_REG_NO -> Unpretty
98 ppr_reg_no B i = uppPStr
100 ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl");
101 ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl");
102 _ -> SLIT("very naughty I386 byte register")
106 ppr_reg_no HB i = uppPStr
108 ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh");
109 ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh");
110 _ -> SLIT("very naughty I386 high byte register")
115 ppr_reg_no S i = uppPStr
117 ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx");
118 ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx");
119 ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
120 ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
121 _ -> SLIT("very naughty I386 word register")
125 ppr_reg_no L i = uppPStr
127 ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
128 ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
129 ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
130 ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
131 _ -> SLIT("very naughty I386 double word register")
134 ppr_reg_no F i = uppPStr
136 --ToDo: rm these (???)
137 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
138 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
139 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
140 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
141 _ -> SLIT("very naughty I386 float register")
144 ppr_reg_no DF i = uppPStr
146 --ToDo: rm these (???)
147 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
148 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
149 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
150 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
151 _ -> SLIT("very naughty I386 float register")
154 #if sparc_TARGET_ARCH
155 ppr_reg_no :: FAST_REG_NO -> Unpretty
156 ppr_reg_no i = uppPStr
158 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
159 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
160 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
161 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
162 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
163 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
164 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
165 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
166 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
167 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
168 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
169 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
170 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
171 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
172 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
173 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
174 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
175 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
176 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
177 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
178 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
179 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
180 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
181 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
182 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
183 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
184 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
185 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
186 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
187 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
188 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
189 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
190 _ -> SLIT("very naughty sparc register")
195 %************************************************************************
197 \subsection{@pprSize@: print a @Size@}
199 %************************************************************************
202 pprSize :: Size -> Unpretty
204 pprSize x = uppPStr (case x of
205 #if alpha_TARGET_ARCH
208 -- W -> SLIT("w") UNUSED
209 -- WU -> SLIT("wu") UNUSED
210 -- L -> SLIT("l") UNUSED
212 -- FF -> SLIT("f") UNUSED
213 -- DF -> SLIT("d") UNUSED
214 -- GF -> SLIT("g") UNUSED
215 -- SF -> SLIT("s") UNUSED
220 -- HB -> SLIT("b") UNUSED
221 -- S -> SLIT("w") UNUSED
226 #if sparc_TARGET_ARCH
229 -- HW -> SLIT("hw") UNUSED
230 -- HWU -> SLIT("uhw") UNUSED
233 -- D -> SLIT("d") UNUSED
239 %************************************************************************
241 \subsection{@pprCond@: print a @Cond@}
243 %************************************************************************
246 pprCond :: Cond -> Unpretty
248 pprCond c = uppPStr (case c of {
249 #if alpha_TARGET_ARCH
260 GEU -> SLIT("ae"); LU -> SLIT("b");
261 EQQ -> SLIT("e"); GTT -> SLIT("g");
262 GE -> SLIT("ge"); GU -> SLIT("a");
263 LTT -> SLIT("l"); LE -> SLIT("le");
264 LEU -> SLIT("be"); NE -> SLIT("ne");
265 NEG -> SLIT("s"); POS -> SLIT("ns");
266 ALWAYS -> SLIT("mp") -- hack
268 #if sparc_TARGET_ARCH
269 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
270 GEU -> SLIT("geu"); LU -> SLIT("lu");
271 EQQ -> SLIT("e"); GTT -> SLIT("g");
272 GE -> SLIT("ge"); GU -> SLIT("gu");
273 LTT -> SLIT("l"); LE -> SLIT("le");
274 LEU -> SLIT("leu"); NE -> SLIT("ne");
275 NEG -> SLIT("neg"); POS -> SLIT("pos");
276 VC -> SLIT("vc"); VS -> SLIT("vs")
281 %************************************************************************
283 \subsection{@pprImm@: print an @Imm@}
285 %************************************************************************
288 pprImm :: Imm -> Unpretty
290 pprImm (ImmInt i) = uppInt i
291 pprImm (ImmInteger i) = uppInteger i
292 pprImm (ImmCLbl l) = pprCLabel_asm l
293 pprImm (ImmLit s) = s
295 pprImm (ImmLab s) | underscorePrefix = uppBeside (uppChar '_') s
298 #if sparc_TARGET_ARCH
300 = uppBesides [ pp_lo, pprImm i, uppRparen ]
302 pp_lo = uppPStr (pACK_STR (a_HASH "%lo("#))
305 = uppBesides [ pp_hi, pprImm i, uppRparen ]
307 pp_hi = uppPStr (pACK_STR (a_HASH "%hi("#))
311 %************************************************************************
313 \subsection{@pprAddr@: print an @Addr@}
315 %************************************************************************
318 pprAddr :: Addr -> Unpretty
320 #if alpha_TARGET_ARCH
321 pprAddr (AddrReg r) = uppParens (pprReg r)
322 pprAddr (AddrImm i) = pprImm i
323 pprAddr (AddrRegImm r1 i)
324 = uppBeside (pprImm i) (uppParens (pprReg r1))
330 pprAddr (ImmAddr imm off)
336 else if (off < 0) then
337 uppBeside pp_imm (uppInt off)
339 uppBesides [pp_imm, uppChar '+', uppInt off]
341 pprAddr (Addr base index displacement)
343 pp_disp = ppr_disp displacement
344 pp_off p = uppBeside pp_disp (uppParens 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 (uppBesides [pp_reg r, uppComma, uppInt i])
351 (Just b, Just (r,i)) -> pp_off (uppBesides [pp_reg b, uppComma, pp_reg r, uppComma, uppInt i])
353 ppr_disp (ImmInt 0) = uppNil
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 = uppBesides [ pprReg r1, uppChar '+', pprReg r2 ]
365 pprAddr (AddrRegImm r1 (ImmInt i))
367 | not (fits13Bits i) = largeOffsetError i
368 | otherwise = uppBesides [ pprReg r1, pp_sign, uppInt i ]
370 pp_sign = if i > 0 then uppChar '+' else uppNil
372 pprAddr (AddrRegImm r1 (ImmInteger i))
374 | not (fits13Bits i) = largeOffsetError i
375 | otherwise = uppBesides [ pprReg r1, pp_sign, uppInteger i ]
377 pp_sign = if i > 0 then uppChar '+' else uppNil
379 pprAddr (AddrRegImm r1 imm)
380 = uppBesides [ pprReg r1, uppChar '+', pprImm imm ]
384 %************************************************************************
386 \subsection{@pprInstr@: print an @Instr@}
388 %************************************************************************
391 pprInstr :: Instr -> Unpretty
393 pprInstr (COMMENT s) = uppNil -- nuke 'em
394 --alpha: = uppBeside (uppPStr SLIT("\t# ")) (uppPStr s)
395 --i386 : = uppBeside (uppPStr SLIT("# ")) (uppPStr s)
396 --sparc: = uppBeside (uppPStr SLIT("! ")) (uppPStr s)
398 pprInstr (SEGMENT TextSegment)
400 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
401 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
402 ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-}
405 pprInstr (SEGMENT DataSegment)
407 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
408 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
409 ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
412 pprInstr (LABEL clab)
414 pp_lab = pprCLabel_asm clab
417 if not (externallyVisibleCLabel clab) then
421 IF_ARCH_alpha(SLIT("\t.globl\t")
422 ,IF_ARCH_i386(SLIT(".globl ")
423 ,IF_ARCH_sparc(SLIT("\t.global\t")
425 , pp_lab, uppChar '\n'],
430 pprInstr (ASCII False{-no backslash conversion-} str)
431 = uppBesides [ uppPStr SLIT("\t.asciz \""), uppStr str, uppChar '"' ]
433 pprInstr (ASCII True str)
434 = uppBeside (uppPStr SLIT("\t.ascii \"")) (asciify str 60)
436 asciify :: String -> Int -> Unpretty
438 asciify [] _ = uppPStr SLIT("\\0\"")
439 asciify s n | n <= 0 = uppBeside (uppPStr SLIT("\"\n\t.ascii \"")) (asciify s 60)
440 asciify ('\\':cs) n = uppBeside (uppStr "\\\\") (asciify cs (n-1))
441 asciify ('\"':cs) n = uppBeside (uppStr "\\\"") (asciify cs (n-1))
442 asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1))
443 asciify [c] _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\""))
444 asciify (c:(cs@(d:_))) n
445 | isDigit d = uppBeside (uppStr (charToC c)) (asciify cs 0)
446 | otherwise = uppBeside (uppStr (charToC c)) (asciify cs (n-1))
449 = uppInterleave (uppChar '\n')
450 [uppBeside (uppPStr 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.long\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)
495 uppPStr SLIT("\tld"),
503 pprInstr (LDA reg addr)
505 uppPStr SLIT("\tlda\t"),
511 pprInstr (LDAH reg addr)
513 uppPStr SLIT("\tldah\t"),
519 pprInstr (LDGP reg addr)
521 uppPStr SLIT("\tldgp\t"),
527 pprInstr (LDI size reg imm)
529 uppPStr SLIT("\tldi"),
537 pprInstr (ST size reg addr)
539 uppPStr SLIT("\tst"),
549 uppPStr SLIT("\tclr\t"),
553 pprInstr (ABS size ri reg)
555 uppPStr SLIT("\tabs"),
563 pprInstr (NEG size ov ri reg)
565 uppPStr SLIT("\tneg"),
567 if ov then uppPStr SLIT("v\t") else uppChar '\t',
573 pprInstr (ADD size ov reg1 ri reg2)
575 uppPStr SLIT("\tadd"),
577 if ov then uppPStr SLIT("v\t") else uppChar '\t',
585 pprInstr (SADD size scale reg1 ri reg2)
587 uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
598 pprInstr (SUB size ov reg1 ri reg2)
600 uppPStr SLIT("\tsub"),
602 if ov then uppPStr SLIT("v\t") else uppChar '\t',
610 pprInstr (SSUB size scale reg1 ri reg2)
612 uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
623 pprInstr (MUL size ov reg1 ri reg2)
625 uppPStr SLIT("\tmul"),
627 if ov then uppPStr SLIT("v\t") else uppChar '\t',
635 pprInstr (DIV size uns reg1 ri reg2)
637 uppPStr SLIT("\tdiv"),
639 if uns then uppPStr SLIT("u\t") else uppChar '\t',
647 pprInstr (REM size uns reg1 ri reg2)
649 uppPStr SLIT("\trem"),
651 if uns then uppPStr SLIT("u\t") else uppChar '\t',
659 pprInstr (NOT ri reg)
661 uppPStr SLIT("\tnot"),
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) = uppPStr SLIT("\tnop")
684 pprInstr (CMP cond reg1 ri reg2)
686 uppPStr SLIT("\tcmp"),
698 uppPStr SLIT("\tfclr\t"),
702 pprInstr (FABS reg1 reg2)
704 uppPStr SLIT("\tfabs\t"),
710 pprInstr (FNEG size reg1 reg2)
712 uppPStr SLIT("\tneg"),
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)
727 uppPStr SLIT("\tcvt"),
729 case size2 of {Q -> uppPStr SLIT("qc"); _ -> pprSize size2},
736 pprInstr (FCMP size cond reg1 reg2 reg3)
738 uppPStr SLIT("\tcmp"),
749 pprInstr (FMOV reg1 reg2)
751 uppPStr SLIT("\tfmov\t"),
757 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
759 pprInstr (BI NEVER reg lab) = uppNil
761 pprInstr (BI cond reg lab)
771 pprInstr (BF cond reg lab)
773 uppPStr SLIT("\tfb"),
782 = uppBeside (uppPStr SLIT("\tbr\t")) (pprImm lab)
784 pprInstr (JMP reg addr hint)
786 uppPStr SLIT("\tjmp\t"),
795 = uppBeside (uppPStr SLIT("\tbsr\t")) (pprImm imm)
797 pprInstr (JSR reg addr n)
799 uppPStr SLIT("\tjsr\t"),
805 pprInstr (FUNBEGIN clab)
807 if (externallyVisibleCLabel clab) then
808 uppBesides [uppPStr SLIT("\t.globl\t"), pp_lab, uppChar '\n']
811 uppPStr SLIT("\t.ent "),
820 pp_lab = pprCLabel_asm clab
822 pp_ldgp = uppPStr (pACK_STR (a_HASH ":\n\tldgp $29,0($27)\n"#))
823 pp_frame = uppPStr (pACK_STR (a_HASH "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#))
825 pprInstr (FUNEND clab)
826 = uppBeside (uppPStr SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
829 Continue with Alpha-only printing bits and bobs:
831 pprRI :: RI -> Unpretty
833 pprRI (RIReg r) = pprReg r
834 pprRI (RIImm r) = pprImm r
836 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Unpretty
838 pprRegRIReg name reg1 ri reg2
850 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
852 pprSizeRegRegReg name size reg1 reg2 reg3
865 #endif {-alpha_TARGET_ARCH-}
868 %************************************************************************
870 \subsubsection{@pprInstr@ for an I386}
872 %************************************************************************
877 pprInstr (MOV size (OpReg src) (OpReg dst)) -- hack
880 pprInstr (MOV size src dst)
881 = pprSizeOpOp SLIT("mov") size src dst
882 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
883 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
885 -- here we do some patching, since the physical registers are only set late
886 -- in the code generation.
887 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
889 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
890 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
892 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
893 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
895 = pprInstr (ADD size (OpImm displ) dst)
896 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
898 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
899 = pprSizeOp SLIT("dec") size dst
900 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
901 = pprSizeOp SLIT("inc") size dst
902 pprInstr (ADD size src dst)
903 = pprSizeOpOp SLIT("add") size src dst
904 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
905 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
906 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
908 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
909 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
910 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
911 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
912 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
913 pprInstr (SHL size imm dst) = pprSizeOpOp SLIT("shl") size imm dst
914 pprInstr (SAR size imm dst) = pprSizeOpOp SLIT("sar") size imm dst
915 pprInstr (SHR size imm dst) = pprSizeOpOp SLIT("shr") size imm dst
917 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
918 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
919 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
920 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
922 pprInstr (NOP) = uppPStr SLIT("\tnop")
923 pprInstr (CLTD) = uppPStr SLIT("\tcltd")
925 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
927 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
929 pprInstr (JMP (OpImm imm)) = uppBeside (uppPStr SLIT("\tjmp ")) (pprImm imm)
930 pprInstr (JMP op) = uppBeside (uppPStr SLIT("\tjmp *")) (pprOperand L op)
933 = uppBesides [ uppPStr SLIT("\tcall "), pprImm imm ]
935 pprInstr SAHF = uppPStr SLIT("\tsahf")
936 pprInstr FABS = uppPStr SLIT("\tfabs")
938 pprInstr (FADD sz src@(OpAddr _))
939 = uppBesides [uppPStr SLIT("\tfadd"), pprSize sz, uppSP, pprOperand sz src]
940 pprInstr (FADD sz src)
941 = uppPStr SLIT("\tfadd")
943 = uppPStr SLIT("\tfaddp")
944 pprInstr (FMUL sz src)
945 = uppBesides [uppPStr SLIT("\tfmul"), pprSize sz, uppSP, pprOperand sz src]
947 = uppPStr SLIT("\tfmulp")
948 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
949 pprInstr FCHS = uppPStr SLIT("\tfchs")
950 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
951 pprInstr FCOS = uppPStr SLIT("\tfcos")
952 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
953 pprInstr (FDIV sz src)
954 = uppBesides [uppPStr SLIT("\tfdiv"), pprSize sz, uppSP, pprOperand sz src]
956 = uppPStr SLIT("\tfdivp")
957 pprInstr (FDIVR sz src)
958 = uppBesides [uppPStr SLIT("\tfdivr"), pprSize sz, uppSP, pprOperand sz src]
960 = uppPStr SLIT("\tfdivpr")
961 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
962 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
963 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
964 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
965 pprInstr (FLD sz (OpImm (ImmCLbl src)))
966 = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprCLabel_asm src]
967 pprInstr (FLD sz src)
968 = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprOperand sz src]
969 pprInstr FLD1 = uppPStr SLIT("\tfld1")
970 pprInstr FLDZ = uppPStr SLIT("\tfldz")
971 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
972 pprInstr FRNDINT = uppPStr SLIT("\tfrndint")
973 pprInstr FSIN = uppPStr SLIT("\tfsin")
974 pprInstr FSQRT = uppPStr SLIT("\tfsqrt")
975 pprInstr (FST sz dst)
976 = uppBesides [uppPStr SLIT("\tfst"), pprSize sz, uppSP, pprOperand sz dst]
977 pprInstr (FSTP sz dst)
978 = uppBesides [uppPStr SLIT("\tfstp"), pprSize sz, uppSP, pprOperand sz dst]
979 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
980 pprInstr (FSUB sz src)
981 = uppBesides [uppPStr SLIT("\tfsub"), pprSize sz, uppSP, pprOperand sz src]
983 = uppPStr SLIT("\tfsubp")
984 pprInstr (FSUBR size src)
985 = pprSizeOp SLIT("fsubr") size src
987 = uppPStr SLIT("\tfsubpr")
988 pprInstr (FISUBR size op)
989 = pprSizeAddr SLIT("fisubr") size op
990 pprInstr FTST = uppPStr SLIT("\tftst")
991 pprInstr (FCOMP sz op)
992 = uppBesides [uppPStr SLIT("\tfcomp"), pprSize sz, uppSP, pprOperand sz op]
993 pprInstr FUCOMPP = uppPStr SLIT("\tfucompp")
994 pprInstr FXCH = uppPStr SLIT("\tfxch")
995 pprInstr FNSTSW = uppPStr SLIT("\tfnstsw %ax")
996 pprInstr FNOP = uppPStr SLIT("")
999 Continue with I386-only printing bits and bobs:
1001 pprDollImm :: Imm -> Unpretty
1003 pprDollImm i = uppBesides [ uppPStr SLIT("$"), pprImm i]
1005 pprOperand :: Size -> Operand -> Unpretty
1006 pprOperand s (OpReg r) = pprReg s r
1007 pprOperand s (OpImm i) = pprDollImm i
1008 pprOperand s (OpAddr ea) = pprAddr ea
1010 pprSizeOp :: FAST_STRING -> Size -> Operand -> Unpretty
1011 pprSizeOp name size op1
1020 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty
1021 pprSizeOpOp name size op1 op2
1027 pprOperand size op1,
1032 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Unpretty
1033 pprSizeOpReg name size op1 reg
1039 pprOperand size op1,
1044 pprSizeAddr :: FAST_STRING -> Size -> Addr -> Unpretty
1045 pprSizeAddr name size op
1054 pprSizeAddrReg :: FAST_STRING -> Size -> Addr -> Reg -> Unpretty
1055 pprSizeAddrReg name size op dst
1066 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty
1067 pprOpOp name size op1 op2
1070 uppPStr name, uppSP,
1071 pprOperand size op1,
1076 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Unpretty
1077 pprSizeOpOpCoerce name size1 size2 op1 op2
1078 = uppBesides [ uppChar '\t', uppPStr name, uppSP,
1079 pprOperand size1 op1,
1081 pprOperand size2 op2
1084 pprCondInstr :: FAST_STRING -> Cond -> Unpretty -> Unpretty
1085 pprCondInstr name cond arg
1086 = uppBesides [ uppChar '\t', uppPStr name, pprCond cond, uppSP, arg]
1088 #endif {-i386_TARGET_ARCH-}
1091 %************************************************************************
1093 \subsubsection{@pprInstr@ for a SPARC}
1095 %************************************************************************
1098 #if sparc_TARGET_ARCH
1100 -- a clumsy hack for now, to handle possible double alignment problems
1102 pprInstr (LD DF addr reg) | maybeToBool off_addr
1116 off_addr = addrOffset addr 4
1117 addr2 = case off_addr of Just x -> x
1119 pprInstr (LD size addr reg)
1121 uppPStr SLIT("\tld"),
1130 -- The same clumsy hack as above
1132 pprInstr (ST DF reg addr) | maybeToBool off_addr
1134 uppPStr SLIT("\tst\t"),
1139 uppPStr SLIT("]\n\tst\t"),
1146 off_addr = addrOffset addr 4
1147 addr2 = case off_addr of Just x -> x
1149 pprInstr (ST size reg addr)
1151 uppPStr SLIT("\tst"),
1160 pprInstr (ADD x cc reg1 ri reg2)
1161 | not x && not cc && riZero ri
1162 = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ]
1164 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1166 pprInstr (SUB x cc reg1 ri reg2)
1167 | not x && cc && reg2 == g0
1168 = uppBesides [ uppPStr SLIT("\tcmp\t"), pprReg reg1, uppComma, pprRI ri ]
1169 | not x && not cc && riZero ri
1170 = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ]
1172 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1174 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1175 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1177 pprInstr (OR b reg1 ri reg2)
1178 | not b && reg1 == g0
1179 = uppBesides [ uppPStr SLIT("\tmov\t"), pprRI ri, uppComma, pprReg reg2 ]
1181 = pprRegRIReg SLIT("or") b reg1 ri reg2
1183 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1185 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1186 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1188 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1189 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1190 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1192 pprInstr (SETHI imm reg)
1194 uppPStr SLIT("\tsethi\t"),
1200 pprInstr NOP = uppPStr SLIT("\tnop")
1202 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1203 pprInstr (FABS DF reg1 reg2)
1204 = uppBeside (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1205 (if (reg1 == reg2) then uppNil
1206 else uppBeside (uppChar '\n')
1207 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1209 pprInstr (FADD size reg1 reg2 reg3)
1210 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1211 pprInstr (FCMP e size reg1 reg2)
1212 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1213 pprInstr (FDIV size reg1 reg2 reg3)
1214 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1216 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1217 pprInstr (FMOV DF reg1 reg2)
1218 = uppBeside (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1219 (if (reg1 == reg2) then uppNil
1220 else uppBeside (uppChar '\n')
1221 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1223 pprInstr (FMUL size reg1 reg2 reg3)
1224 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1226 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1227 pprInstr (FNEG DF reg1 reg2)
1228 = uppBeside (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1229 (if (reg1 == reg2) then uppNil
1230 else uppBeside (uppChar '\n')
1231 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1233 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1234 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1235 pprInstr (FxTOy size1 size2 reg1 reg2)
1237 uppPStr SLIT("\tf"),
1248 pprReg reg1, uppComma, pprReg reg2
1252 pprInstr (BI cond b lab)
1254 uppPStr SLIT("\tb"), pprCond cond,
1255 if b then pp_comma_a else uppNil,
1260 pprInstr (BF cond b lab)
1262 uppPStr SLIT("\tfb"), pprCond cond,
1263 if b then pp_comma_a else uppNil,
1268 pprInstr (JMP addr) = uppBeside (uppPStr SLIT("\tjmp\t")) (pprAddr addr)
1270 pprInstr (CALL imm n _)
1271 = uppBesides [ uppPStr SLIT("\tcall\t"), pprImm imm, uppComma, uppInt n ]
1274 Continue with SPARC-only printing bits and bobs:
1276 pprRI :: RI -> Unpretty
1277 pprRI (RIReg r) = pprReg r
1278 pprRI (RIImm r) = pprImm r
1280 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Unpretty
1281 pprSizeRegReg name size reg1 reg2
1286 F -> uppPStr SLIT("s\t")
1287 DF -> uppPStr SLIT("d\t")),
1293 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
1294 pprSizeRegRegReg name size reg1 reg2 reg3
1299 F -> uppPStr SLIT("s\t")
1300 DF -> uppPStr SLIT("d\t")),
1308 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Unpretty
1309 pprRegRIReg name b reg1 ri reg2
1313 if b then uppPStr SLIT("cc\t") else uppChar '\t',
1321 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Unpretty
1322 pprRIReg name b ri reg1
1326 if b then uppPStr SLIT("cc\t") else uppChar '\t',
1332 pp_ld_lbracket = uppPStr (pACK_STR (a_HASH "\tld\t["#))
1333 pp_rbracket_comma = uppPStr (pACK_STR (a_HASH "],"#))
1334 pp_comma_lbracket = uppPStr (pACK_STR (a_HASH ",["#))
1335 pp_comma_a = uppPStr (pACK_STR (a_HASH ",a"#))
1337 #endif {-sparc_TARGET_ARCH-}