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
19 #if __GLASGOW_HASKELL__ >= 200
20 # define A_HASH GHCbase.A#
25 import MachRegs -- may differ per-platform
28 import AbsCSyn ( MagicId )
29 import CLabel ( pprCLabel_asm, externallyVisibleCLabel )
30 import CStrings ( charToC )
31 import Maybes ( maybeToBool )
32 import OrdList ( OrdList )
33 import Stix ( CodeSegment(..), StixTree )
34 import Unpretty -- all of it
37 %************************************************************************
39 \subsection{@pprReg@: print a @Reg@}
41 %************************************************************************
43 For x86, the way we print a register name depends
44 on which bit of it we care about. Yurgh.
46 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Unpretty
48 pprReg IF_ARCH_i386(s,) r
50 FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
51 MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
52 other -> uppStr (show other) -- should only happen when debugging
55 ppr_reg_no :: FAST_REG_NO -> Unpretty
56 ppr_reg_no i = uppPStr
58 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
59 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
60 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
61 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
62 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
63 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
64 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
65 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
66 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
67 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
68 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
69 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
70 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
71 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
72 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
73 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
74 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
75 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
76 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
77 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
78 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
79 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
80 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
81 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
82 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
83 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
84 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
85 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
86 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
87 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
88 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
89 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
90 _ -> SLIT("very naughty alpha register")
94 ppr_reg_no :: Size -> FAST_REG_NO -> Unpretty
95 ppr_reg_no B i = uppPStr
97 ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl");
98 ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl");
99 _ -> SLIT("very naughty I386 byte register")
103 ppr_reg_no HB i = uppPStr
105 ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh");
106 ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh");
107 _ -> SLIT("very naughty I386 high byte register")
112 ppr_reg_no S i = uppPStr
114 ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx");
115 ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx");
116 ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
117 ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
118 _ -> SLIT("very naughty I386 word register")
122 ppr_reg_no L i = uppPStr
124 ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
125 ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
126 ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
127 ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
128 _ -> SLIT("very naughty I386 double word register")
131 ppr_reg_no F i = uppPStr
133 --ToDo: rm these (???)
134 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
135 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
136 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
137 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
138 _ -> SLIT("very naughty I386 float register")
141 ppr_reg_no DF i = uppPStr
143 --ToDo: rm these (???)
144 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
145 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
146 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
147 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
148 _ -> SLIT("very naughty I386 float register")
151 #if sparc_TARGET_ARCH
152 ppr_reg_no :: FAST_REG_NO -> Unpretty
153 ppr_reg_no i = uppPStr
155 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
156 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
157 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
158 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
159 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
160 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
161 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
162 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
163 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
164 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
165 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
166 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
167 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
168 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
169 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
170 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
171 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
172 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
173 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
174 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
175 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
176 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
177 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
178 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
179 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
180 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
181 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
182 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
183 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
184 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
185 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
186 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
187 _ -> SLIT("very naughty sparc register")
192 %************************************************************************
194 \subsection{@pprSize@: print a @Size@}
196 %************************************************************************
199 pprSize :: Size -> Unpretty
201 pprSize x = uppPStr (case x of
202 #if alpha_TARGET_ARCH
205 -- W -> SLIT("w") UNUSED
206 -- WU -> SLIT("wu") UNUSED
207 -- L -> SLIT("l") UNUSED
209 -- FF -> SLIT("f") UNUSED
210 -- DF -> SLIT("d") UNUSED
211 -- GF -> SLIT("g") UNUSED
212 -- SF -> SLIT("s") UNUSED
217 -- HB -> SLIT("b") UNUSED
218 -- S -> SLIT("w") UNUSED
223 #if sparc_TARGET_ARCH
226 -- HW -> SLIT("hw") UNUSED
227 -- HWU -> SLIT("uhw") UNUSED
230 -- D -> SLIT("d") UNUSED
236 %************************************************************************
238 \subsection{@pprCond@: print a @Cond@}
240 %************************************************************************
243 pprCond :: Cond -> Unpretty
245 pprCond c = uppPStr (case c of {
246 #if alpha_TARGET_ARCH
257 GEU -> SLIT("ae"); LU -> SLIT("b");
258 EQQ -> SLIT("e"); GTT -> SLIT("g");
259 GE -> SLIT("ge"); GU -> SLIT("a");
260 LTT -> SLIT("l"); LE -> SLIT("le");
261 LEU -> SLIT("be"); NE -> SLIT("ne");
262 NEG -> SLIT("s"); POS -> SLIT("ns");
263 ALWAYS -> SLIT("mp") -- hack
265 #if sparc_TARGET_ARCH
266 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
267 GEU -> SLIT("geu"); LU -> SLIT("lu");
268 EQQ -> SLIT("e"); GTT -> SLIT("g");
269 GE -> SLIT("ge"); GU -> SLIT("gu");
270 LTT -> SLIT("l"); LE -> SLIT("le");
271 LEU -> SLIT("leu"); NE -> SLIT("ne");
272 NEG -> SLIT("neg"); POS -> SLIT("pos");
273 VC -> SLIT("vc"); VS -> SLIT("vs")
278 %************************************************************************
280 \subsection{@pprImm@: print an @Imm@}
282 %************************************************************************
285 pprImm :: Imm -> Unpretty
287 pprImm (ImmInt i) = uppInt i
288 pprImm (ImmInteger i) = uppInteger i
289 pprImm (ImmCLbl l) = pprCLabel_asm l
290 pprImm (ImmLit s) = s
292 pprImm (ImmLab s) | underscorePrefix = uppBeside (uppChar '_') s
295 #if sparc_TARGET_ARCH
297 = uppBesides [ pp_lo, pprImm i, uppRparen ]
299 pp_lo = uppPStr (_packCString (A_HASH "%lo("#))
302 = uppBesides [ pp_hi, pprImm i, uppRparen ]
304 pp_hi = uppPStr (_packCString (A_HASH "%hi("#))
308 %************************************************************************
310 \subsection{@pprAddr@: print an @Addr@}
312 %************************************************************************
315 pprAddr :: Addr -> Unpretty
317 #if alpha_TARGET_ARCH
318 pprAddr (AddrReg r) = uppParens (pprReg r)
319 pprAddr (AddrImm i) = pprImm i
320 pprAddr (AddrRegImm r1 i)
321 = uppBeside (pprImm i) (uppParens (pprReg r1))
327 pprAddr (ImmAddr imm off)
333 else if (off < 0) then
334 uppBeside pp_imm (uppInt off)
336 uppBesides [pp_imm, uppChar '+', uppInt off]
338 pprAddr (Addr base index displacement)
340 pp_disp = ppr_disp displacement
341 pp_off p = uppBeside pp_disp (uppParens p)
342 pp_reg r = pprReg L r
345 (Nothing, Nothing) -> pp_disp
346 (Just b, Nothing) -> pp_off (pp_reg b)
347 (Nothing, Just (r,i)) -> pp_off (uppBesides [pp_reg r, uppComma, uppInt i])
348 (Just b, Just (r,i)) -> pp_off (uppBesides [pp_reg b, uppComma, pp_reg r, uppComma, uppInt i])
350 ppr_disp (ImmInt 0) = uppNil
351 ppr_disp imm = pprImm imm
356 #if sparc_TARGET_ARCH
357 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
359 pprAddr (AddrRegReg r1 r2)
360 = uppBesides [ pprReg r1, uppChar '+', pprReg r2 ]
362 pprAddr (AddrRegImm r1 (ImmInt i))
364 | not (fits13Bits i) = largeOffsetError i
365 | otherwise = uppBesides [ pprReg r1, pp_sign, uppInt i ]
367 pp_sign = if i > 0 then uppChar '+' else uppNil
369 pprAddr (AddrRegImm r1 (ImmInteger i))
371 | not (fits13Bits i) = largeOffsetError i
372 | otherwise = uppBesides [ pprReg r1, pp_sign, uppInteger i ]
374 pp_sign = if i > 0 then uppChar '+' else uppNil
376 pprAddr (AddrRegImm r1 imm)
377 = uppBesides [ pprReg r1, uppChar '+', pprImm imm ]
381 %************************************************************************
383 \subsection{@pprInstr@: print an @Instr@}
385 %************************************************************************
388 pprInstr :: Instr -> Unpretty
390 pprInstr (COMMENT s) = uppNil -- nuke 'em
391 --alpha: = uppBeside (uppPStr SLIT("\t# ")) (uppPStr s)
392 --i386 : = uppBeside (uppPStr SLIT("# ")) (uppPStr s)
393 --sparc: = uppBeside (uppPStr SLIT("! ")) (uppPStr s)
395 pprInstr (SEGMENT TextSegment)
397 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
398 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
399 ,IF_ARCH_i386(SLIT(".text\n\t.align 2,0x90") {-needs per-OS variation!-}
402 pprInstr (SEGMENT DataSegment)
404 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
405 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
406 ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
409 pprInstr (LABEL clab)
411 pp_lab = pprCLabel_asm clab
414 if not (externallyVisibleCLabel clab) then
418 IF_ARCH_alpha(SLIT("\t.globl\t")
419 ,IF_ARCH_i386(SLIT(".globl ")
420 ,IF_ARCH_sparc(SLIT("\t.global\t")
422 , pp_lab, uppChar '\n'],
427 pprInstr (ASCII False{-no backslash conversion-} str)
428 = uppBesides [ uppStr "\t.asciz \"", uppStr str, uppChar '"' ]
430 pprInstr (ASCII True str)
431 = uppBeside (uppStr "\t.ascii \"") (asciify str 60)
433 asciify :: String -> Int -> Unpretty
435 asciify [] _ = uppStr ("\\0\"")
436 asciify s n | n <= 0 = uppBeside (uppStr "\"\n\t.ascii \"") (asciify s 60)
437 asciify ('\\':cs) n = uppBeside (uppStr "\\\\") (asciify cs (n-1))
438 asciify ('\"':cs) n = uppBeside (uppStr "\\\"") (asciify cs (n-1))
439 asciify (c:cs) n | isPrint c = uppBeside (uppChar c) (asciify cs (n-1))
440 asciify [c] _ = uppBeside (uppStr (charToC c)) (uppStr ("\\0\""))
441 asciify (c:(cs@(d:_))) n
442 | isDigit d = uppBeside (uppStr (charToC c)) (asciify cs 0)
443 | otherwise = uppBeside (uppStr (charToC c)) (asciify cs (n-1))
446 = uppInterleave (uppChar '\n')
447 [uppBeside (uppPStr pp_size) (pprImm x) | x <- xs]
450 #if alpha_TARGET_ARCH
451 B -> SLIT("\t.byte\t")
452 BU -> SLIT("\t.byte\t")
453 --UNUSED: W -> SLIT("\t.word\t")
454 --UNUSED: WU -> SLIT("\t.word\t")
455 --UNUSED: L -> SLIT("\t.long\t")
456 Q -> SLIT("\t.quad\t")
457 --UNUSED: FF -> SLIT("\t.f_floating\t")
458 --UNUSED: DF -> SLIT("\t.d_floating\t")
459 --UNUSED: GF -> SLIT("\t.g_floating\t")
460 --UNUSED: SF -> SLIT("\t.s_floating\t")
461 TF -> SLIT("\t.t_floating\t")
464 B -> SLIT("\t.byte\t")
465 --UNUSED: HB -> SLIT("\t.byte\t")
466 --UNUSED: S -> SLIT("\t.word\t")
467 L -> SLIT("\t.long\t")
468 F -> SLIT("\t.long\t")
469 DF -> SLIT("\t.double\t")
471 #if sparc_TARGET_ARCH
472 B -> SLIT("\t.byte\t")
473 BU -> SLIT("\t.byte\t")
474 W -> SLIT("\t.word\t")
475 DF -> SLIT("\t.double\t")
478 -- fall through to rest of (machine-specific) pprInstr...
481 %************************************************************************
483 \subsubsection{@pprInstr@ for an Alpha}
485 %************************************************************************
488 #if alpha_TARGET_ARCH
490 pprInstr (LD size reg addr)
492 uppPStr SLIT("\tld"),
500 pprInstr (LDA reg addr)
502 uppPStr SLIT("\tlda\t"),
508 pprInstr (LDAH reg addr)
510 uppPStr SLIT("\tldah\t"),
516 pprInstr (LDGP reg addr)
518 uppPStr SLIT("\tldgp\t"),
524 pprInstr (LDI size reg imm)
526 uppPStr SLIT("\tldi"),
534 pprInstr (ST size reg addr)
536 uppPStr SLIT("\tst"),
546 uppPStr SLIT("\tclr\t"),
550 pprInstr (ABS size ri reg)
552 uppPStr SLIT("\tabs"),
560 pprInstr (NEG size ov ri reg)
562 uppPStr SLIT("\tneg"),
564 if ov then uppPStr SLIT("v\t") else uppChar '\t',
570 pprInstr (ADD size ov reg1 ri reg2)
572 uppPStr SLIT("\tadd"),
574 if ov then uppPStr SLIT("v\t") else uppChar '\t',
582 pprInstr (SADD size scale reg1 ri reg2)
584 uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
595 pprInstr (SUB size ov reg1 ri reg2)
597 uppPStr SLIT("\tsub"),
599 if ov then uppPStr SLIT("v\t") else uppChar '\t',
607 pprInstr (SSUB size scale reg1 ri reg2)
609 uppPStr (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
620 pprInstr (MUL size ov reg1 ri reg2)
622 uppPStr SLIT("\tmul"),
624 if ov then uppPStr SLIT("v\t") else uppChar '\t',
632 pprInstr (DIV size uns reg1 ri reg2)
634 uppPStr SLIT("\tdiv"),
636 if uns then uppPStr SLIT("u\t") else uppChar '\t',
644 pprInstr (REM size uns reg1 ri reg2)
646 uppPStr SLIT("\trem"),
648 if uns then uppPStr SLIT("u\t") else uppChar '\t',
656 pprInstr (NOT ri reg)
658 uppPStr SLIT("\tnot"),
665 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
666 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
667 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
668 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
669 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
670 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
672 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
673 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
674 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
676 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
677 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
679 pprInstr (NOP) = uppPStr SLIT("\tnop")
681 pprInstr (CMP cond reg1 ri reg2)
683 uppPStr SLIT("\tcmp"),
695 uppPStr SLIT("\tfclr\t"),
699 pprInstr (FABS reg1 reg2)
701 uppPStr SLIT("\tfabs\t"),
707 pprInstr (FNEG size reg1 reg2)
709 uppPStr SLIT("\tneg"),
717 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
718 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
719 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
720 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
722 pprInstr (CVTxy size1 size2 reg1 reg2)
724 uppPStr SLIT("\tcvt"),
726 case size2 of {Q -> uppPStr SLIT("qc"); _ -> pprSize size2},
733 pprInstr (FCMP size cond reg1 reg2 reg3)
735 uppPStr SLIT("\tcmp"),
746 pprInstr (FMOV reg1 reg2)
748 uppPStr SLIT("\tfmov\t"),
754 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
756 pprInstr (BI NEVER reg lab) = uppNil
758 pprInstr (BI cond reg lab)
768 pprInstr (BF cond reg lab)
770 uppPStr SLIT("\tfb"),
779 = uppBeside (uppPStr SLIT("\tbr\t")) (pprImm lab)
781 pprInstr (JMP reg addr hint)
783 uppPStr SLIT("\tjmp\t"),
792 = uppBeside (uppPStr SLIT("\tbsr\t")) (pprImm imm)
794 pprInstr (JSR reg addr n)
796 uppPStr SLIT("\tjsr\t"),
802 pprInstr (FUNBEGIN clab)
804 if (externallyVisibleCLabel clab) then
805 uppBesides [uppPStr SLIT("\t.globl\t"), pp_lab, uppChar '\n']
808 uppPStr SLIT("\t.ent "),
817 pp_lab = pprCLabel_asm clab
819 #if __GLASGOW_HASKELL__ >= 200
820 # define PACK_STR packCString
822 # define PACK_STR _packCString
824 pp_ldgp = uppPStr (PACK_STR (A_HASH ":\n\tldgp $29,0($27)\n"#))
825 pp_frame = uppPStr (PACK_STR (A_HASH "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#))
827 pprInstr (FUNEND clab)
828 = uppBeside (uppPStr SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
831 Continue with Alpha-only printing bits and bobs:
833 pprRI :: RI -> Unpretty
835 pprRI (RIReg r) = pprReg r
836 pprRI (RIImm r) = pprImm r
838 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Unpretty
840 pprRegRIReg name reg1 ri reg2
852 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
854 pprSizeRegRegReg name size reg1 reg2 reg3
867 #endif {-alpha_TARGET_ARCH-}
870 %************************************************************************
872 \subsubsection{@pprInstr@ for an I386}
874 %************************************************************************
879 pprInstr (MOV size (OpReg src) (OpReg dst)) -- hack
882 pprInstr (MOV size src dst)
883 = pprSizeOpOp SLIT("mov") size src dst
884 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
885 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
887 -- here we do some patching, since the physical registers are only set late
888 -- in the code generation.
889 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
891 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
892 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
894 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
895 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
897 = pprInstr (ADD size (OpImm displ) dst)
898 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
900 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
901 = pprSizeOp SLIT("dec") size dst
902 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
903 = pprSizeOp SLIT("inc") size dst
904 pprInstr (ADD size src dst)
905 = pprSizeOpOp SLIT("add") size src dst
906 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
907 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
908 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
910 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
911 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
912 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
913 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
914 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
915 pprInstr (SHL size imm dst) = pprSizeOpOp SLIT("shl") size imm dst
916 pprInstr (SAR size imm dst) = pprSizeOpOp SLIT("sar") size imm dst
917 pprInstr (SHR size imm dst) = pprSizeOpOp SLIT("shr") size imm dst
919 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
920 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
921 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
922 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
924 pprInstr (NOP) = uppPStr SLIT("\tnop")
925 pprInstr (CLTD) = uppPStr SLIT("\tcltd")
927 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
929 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
931 pprInstr (JMP (OpImm imm)) = uppBeside (uppPStr SLIT("\tjmp ")) (pprImm imm)
932 pprInstr (JMP op) = uppBeside (uppPStr SLIT("\tjmp *")) (pprOperand L op)
935 = uppBesides [ uppPStr SLIT("\tcall "), pprImm imm ]
937 pprInstr SAHF = uppPStr SLIT("\tsahf")
938 pprInstr FABS = uppPStr SLIT("\tfabs")
940 pprInstr (FADD sz src@(OpAddr _))
941 = uppBesides [uppPStr SLIT("\tfadd"), pprSize sz, uppSP, pprOperand sz src]
942 pprInstr (FADD sz src)
943 = uppPStr SLIT("\tfadd")
945 = uppPStr SLIT("\tfaddp")
946 pprInstr (FMUL sz src)
947 = uppBesides [uppPStr SLIT("\tfmul"), pprSize sz, uppSP, pprOperand sz src]
949 = uppPStr SLIT("\tfmulp")
950 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
951 pprInstr FCHS = uppPStr SLIT("\tfchs")
952 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
953 pprInstr FCOS = uppPStr SLIT("\tfcos")
954 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
955 pprInstr (FDIV sz src)
956 = uppBesides [uppPStr SLIT("\tfdiv"), pprSize sz, uppSP, pprOperand sz src]
958 = uppPStr SLIT("\tfdivp")
959 pprInstr (FDIVR sz src)
960 = uppBesides [uppPStr SLIT("\tfdivr"), pprSize sz, uppSP, pprOperand sz src]
962 = uppPStr SLIT("\tfdivpr")
963 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
964 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
965 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
966 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
967 pprInstr (FLD sz (OpImm (ImmCLbl src)))
968 = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprCLabel_asm src]
969 pprInstr (FLD sz src)
970 = uppBesides [uppPStr SLIT("\tfld"),pprSize sz,uppSP,pprOperand sz src]
971 pprInstr FLD1 = uppPStr SLIT("\tfld1")
972 pprInstr FLDZ = uppPStr SLIT("\tfldz")
973 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
974 pprInstr FRNDINT = uppPStr SLIT("\tfrndint")
975 pprInstr FSIN = uppPStr SLIT("\tfsin")
976 pprInstr FSQRT = uppPStr SLIT("\tfsqrt")
977 pprInstr (FST sz dst)
978 = uppBesides [uppPStr SLIT("\tfst"), pprSize sz, uppSP, pprOperand sz dst]
979 pprInstr (FSTP sz dst)
980 = uppBesides [uppPStr SLIT("\tfstp"), pprSize sz, uppSP, pprOperand sz dst]
981 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
982 pprInstr (FSUB sz src)
983 = uppBesides [uppPStr SLIT("\tfsub"), pprSize sz, uppSP, pprOperand sz src]
985 = uppPStr SLIT("\tfsubp")
986 pprInstr (FSUBR size src)
987 = pprSizeOp SLIT("fsubr") size src
989 = uppPStr SLIT("\tfsubpr")
990 pprInstr (FISUBR size op)
991 = pprSizeAddr SLIT("fisubr") size op
992 pprInstr FTST = uppPStr SLIT("\tftst")
993 pprInstr (FCOMP sz op)
994 = uppBesides [uppPStr SLIT("\tfcomp"), pprSize sz, uppSP, pprOperand sz op]
995 pprInstr FUCOMPP = uppPStr SLIT("\tfucompp")
996 pprInstr FXCH = uppPStr SLIT("\tfxch")
997 pprInstr FNSTSW = uppPStr SLIT("\tfnstsw %ax")
998 pprInstr FNOP = uppPStr SLIT("")
1001 Continue with I386-only printing bits and bobs:
1003 pprDollImm :: Imm -> Unpretty
1005 pprDollImm i = uppBesides [ uppPStr SLIT("$"), pprImm i]
1007 pprOperand :: Size -> Operand -> Unpretty
1008 pprOperand s (OpReg r) = pprReg s r
1009 pprOperand s (OpImm i) = pprDollImm i
1010 pprOperand s (OpAddr ea) = pprAddr ea
1012 pprSizeOp :: FAST_STRING -> Size -> Operand -> Unpretty
1013 pprSizeOp name size op1
1022 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty
1023 pprSizeOpOp name size op1 op2
1029 pprOperand size op1,
1034 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Unpretty
1035 pprSizeOpReg name size op1 reg
1041 pprOperand size op1,
1046 pprSizeAddr :: FAST_STRING -> Size -> Addr -> Unpretty
1047 pprSizeAddr name size op
1056 pprSizeAddrReg :: FAST_STRING -> Size -> Addr -> Reg -> Unpretty
1057 pprSizeAddrReg name size op dst
1068 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Unpretty
1069 pprOpOp name size op1 op2
1072 uppPStr name, uppSP,
1073 pprOperand size op1,
1078 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Unpretty
1079 pprSizeOpOpCoerce name size1 size2 op1 op2
1080 = uppBesides [ uppChar '\t', uppPStr name, uppSP,
1081 pprOperand size1 op1,
1083 pprOperand size2 op2
1086 pprCondInstr :: FAST_STRING -> Cond -> Unpretty -> Unpretty
1087 pprCondInstr name cond arg
1088 = uppBesides [ uppChar '\t', uppPStr name, pprCond cond, uppSP, arg]
1090 #endif {-i386_TARGET_ARCH-}
1093 %************************************************************************
1095 \subsubsection{@pprInstr@ for a SPARC}
1097 %************************************************************************
1100 #if sparc_TARGET_ARCH
1102 -- a clumsy hack for now, to handle possible double alignment problems
1104 pprInstr (LD DF addr reg) | maybeToBool off_addr
1118 off_addr = addrOffset addr 4
1119 addr2 = case off_addr of Just x -> x
1121 pprInstr (LD size addr reg)
1123 uppPStr SLIT("\tld"),
1132 -- The same clumsy hack as above
1134 pprInstr (ST DF reg addr) | maybeToBool off_addr
1136 uppPStr SLIT("\tst\t"),
1141 uppPStr SLIT("]\n\tst\t"),
1148 off_addr = addrOffset addr 4
1149 addr2 = case off_addr of Just x -> x
1151 pprInstr (ST size reg addr)
1153 uppPStr SLIT("\tst"),
1162 pprInstr (ADD x cc reg1 ri reg2)
1163 | not x && not cc && riZero ri
1164 = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ]
1166 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1168 pprInstr (SUB x cc reg1 ri reg2)
1169 | not x && cc && reg2 == g0
1170 = uppBesides [ uppPStr SLIT("\tcmp\t"), pprReg reg1, uppComma, pprRI ri ]
1171 | not x && not cc && riZero ri
1172 = uppBesides [ uppPStr SLIT("\tmov\t"), pprReg reg1, uppComma, pprReg reg2 ]
1174 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1176 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1177 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1179 pprInstr (OR b reg1 ri reg2)
1180 | not b && reg1 == g0
1181 = uppBesides [ uppPStr SLIT("\tmov\t"), pprRI ri, uppComma, pprReg reg2 ]
1183 = pprRegRIReg SLIT("or") b reg1 ri reg2
1185 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1187 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1188 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1190 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1191 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1192 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1194 pprInstr (SETHI imm reg)
1196 uppPStr SLIT("\tsethi\t"),
1202 pprInstr NOP = uppPStr SLIT("\tnop")
1204 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1205 pprInstr (FABS DF reg1 reg2)
1206 = uppBeside (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1207 (if (reg1 == reg2) then uppNil
1208 else uppBeside (uppChar '\n')
1209 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1211 pprInstr (FADD size reg1 reg2 reg3)
1212 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1213 pprInstr (FCMP e size reg1 reg2)
1214 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1215 pprInstr (FDIV size reg1 reg2 reg3)
1216 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1218 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1219 pprInstr (FMOV DF reg1 reg2)
1220 = uppBeside (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1221 (if (reg1 == reg2) then uppNil
1222 else uppBeside (uppChar '\n')
1223 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1225 pprInstr (FMUL size reg1 reg2 reg3)
1226 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1228 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1229 pprInstr (FNEG DF reg1 reg2)
1230 = uppBeside (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1231 (if (reg1 == reg2) then uppNil
1232 else uppBeside (uppChar '\n')
1233 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1235 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1236 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1237 pprInstr (FxTOy size1 size2 reg1 reg2)
1239 uppPStr SLIT("\tf"),
1250 pprReg reg1, uppComma, pprReg reg2
1254 pprInstr (BI cond b lab)
1256 uppPStr SLIT("\tb"), pprCond cond,
1257 if b then pp_comma_a else uppNil,
1262 pprInstr (BF cond b lab)
1264 uppPStr SLIT("\tfb"), pprCond cond,
1265 if b then pp_comma_a else uppNil,
1270 pprInstr (JMP addr) = uppBeside (uppPStr SLIT("\tjmp\t")) (pprAddr addr)
1272 pprInstr (CALL imm n _)
1273 = uppBesides [ uppPStr SLIT("\tcall\t"), pprImm imm, uppComma, uppInt n ]
1276 Continue with SPARC-only printing bits and bobs:
1278 pprRI :: RI -> Unpretty
1279 pprRI (RIReg r) = pprReg r
1280 pprRI (RIImm r) = pprImm r
1282 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Unpretty
1283 pprSizeRegReg name size reg1 reg2
1288 F -> uppPStr SLIT("s\t")
1289 DF -> uppPStr SLIT("d\t")),
1295 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Unpretty
1296 pprSizeRegRegReg name size reg1 reg2 reg3
1301 F -> uppPStr SLIT("s\t")
1302 DF -> uppPStr SLIT("d\t")),
1310 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Unpretty
1311 pprRegRIReg name b reg1 ri reg2
1315 if b then uppPStr SLIT("cc\t") else uppChar '\t',
1323 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Unpretty
1324 pprRIReg name b ri reg1
1328 if b then uppPStr SLIT("cc\t") else uppChar '\t',
1334 pp_ld_lbracket = uppPStr (PACK_STR (A_HASH "\tld\t["#))
1335 pp_rbracket_comma = uppPStr (PACK_STR (A_HASH "],"#))
1336 pp_comma_lbracket = uppPStr (PACK_STR (A_HASH ",["#))
1337 pp_comma_a = uppPStr (PACK_STR (A_HASH ",a"#))
1339 #endif {-sparc_TARGET_ARCH-}