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_1_3(Char(isPrint,isDigit))
17 #if __GLASGOW_HASKELL__ == 201
18 import qualified GHCbase(Addr(..)) -- to see innards
20 #elif __GLASGOW_HASKELL__ >= 202
21 import qualified GlaExts (Addr(..))
22 import GlaExts hiding (Addr(..))
28 import MachRegs -- may differ per-platform
31 import AbsCSyn ( MagicId )
32 import CLabel ( pprCLabel_asm, externallyVisibleCLabel )
33 import CStrings ( charToC )
34 import Maybes ( maybeToBool )
35 import OrdList ( OrdList )
36 import Stix ( CodeSegment(..), StixTree )
37 import Pretty -- all of it
39 #if __GLASGOW_HASKELL__ == 201
40 a_HASH x = GHCbase.A# x
41 pACK_STR x = packCString x
42 #elif __GLASGOW_HASKELL__ >= 202
43 a_HASH x = GlaExts.A# x
44 pACK_STR x = mkFastCharString x
47 pACK_STR x = mkFastCharString x --_packCString x
51 %************************************************************************
53 \subsection{@pprReg@: print a @Reg@}
55 %************************************************************************
57 For x86, the way we print a register name depends
58 on which bit of it we care about. Yurgh.
60 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc
62 pprReg IF_ARCH_i386(s,) r
64 FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
65 MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
66 other -> text (show other) -- should only happen when debugging
69 ppr_reg_no :: FAST_REG_NO -> Doc
72 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
73 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
74 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
75 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
76 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
77 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
78 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
79 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
80 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
81 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
82 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
83 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
84 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
85 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
86 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
87 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
88 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
89 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
90 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
91 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
92 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
93 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
94 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
95 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
96 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
97 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
98 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
99 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
100 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
101 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
102 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
103 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
104 _ -> SLIT("very naughty alpha register")
108 ppr_reg_no :: Size -> FAST_REG_NO -> Doc
109 ppr_reg_no B i = ptext
111 ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl");
112 ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl");
113 _ -> SLIT("very naughty I386 byte register")
117 ppr_reg_no HB i = ptext
119 ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh");
120 ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh");
121 _ -> SLIT("very naughty I386 high byte register")
126 ppr_reg_no S i = ptext
128 ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx");
129 ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx");
130 ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
131 ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
132 _ -> SLIT("very naughty I386 word register")
136 ppr_reg_no L i = ptext
138 ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
139 ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
140 ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
141 ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
142 _ -> SLIT("very naughty I386 double word register")
145 ppr_reg_no F i = ptext
147 --ToDo: rm these (???)
148 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
149 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
150 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
151 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
152 _ -> SLIT("very naughty I386 float register")
155 ppr_reg_no DF i = ptext
157 --ToDo: rm these (???)
158 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
159 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
160 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
161 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
162 _ -> SLIT("very naughty I386 float register")
165 #if sparc_TARGET_ARCH
166 ppr_reg_no :: FAST_REG_NO -> Doc
169 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
170 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
171 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
172 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
173 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
174 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
175 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
176 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
177 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
178 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
179 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
180 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
181 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
182 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
183 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
184 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
185 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
186 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
187 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
188 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
189 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
190 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
191 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
192 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
193 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
194 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
195 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
196 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
197 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
198 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
199 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
200 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
201 _ -> SLIT("very naughty sparc register")
206 %************************************************************************
208 \subsection{@pprSize@: print a @Size@}
210 %************************************************************************
213 pprSize :: Size -> Doc
215 pprSize x = ptext (case x of
216 #if alpha_TARGET_ARCH
219 -- W -> SLIT("w") UNUSED
220 -- WU -> SLIT("wu") UNUSED
221 -- L -> SLIT("l") UNUSED
223 -- FF -> SLIT("f") UNUSED
224 -- DF -> SLIT("d") UNUSED
225 -- GF -> SLIT("g") UNUSED
226 -- SF -> SLIT("s") UNUSED
231 -- HB -> SLIT("b") UNUSED
232 -- S -> SLIT("w") UNUSED
237 #if sparc_TARGET_ARCH
240 -- HW -> SLIT("hw") UNUSED
241 -- HWU -> SLIT("uhw") UNUSED
244 -- D -> SLIT("d") UNUSED
247 pprStSize :: Size -> Doc
248 pprStSize x = ptext (case x of
251 -- HW -> SLIT("hw") UNUSED
252 -- HWU -> SLIT("uhw") UNUSED
255 -- D -> SLIT("d") UNUSED
261 %************************************************************************
263 \subsection{@pprCond@: print a @Cond@}
265 %************************************************************************
268 pprCond :: Cond -> Doc
270 pprCond c = ptext (case c of {
271 #if alpha_TARGET_ARCH
282 GEU -> SLIT("ae"); LU -> SLIT("b");
283 EQQ -> SLIT("e"); GTT -> SLIT("g");
284 GE -> SLIT("ge"); GU -> SLIT("a");
285 LTT -> SLIT("l"); LE -> SLIT("le");
286 LEU -> SLIT("be"); NE -> SLIT("ne");
287 NEG -> SLIT("s"); POS -> SLIT("ns");
288 ALWAYS -> SLIT("mp") -- hack
290 #if sparc_TARGET_ARCH
291 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
292 GEU -> SLIT("geu"); LU -> SLIT("lu");
293 EQQ -> SLIT("e"); GTT -> SLIT("g");
294 GE -> SLIT("ge"); GU -> SLIT("gu");
295 LTT -> SLIT("l"); LE -> SLIT("le");
296 LEU -> SLIT("leu"); NE -> SLIT("ne");
297 NEG -> SLIT("neg"); POS -> SLIT("pos");
298 VC -> SLIT("vc"); VS -> SLIT("vs")
303 %************************************************************************
305 \subsection{@pprImm@: print an @Imm@}
307 %************************************************************************
312 pprImm (ImmInt i) = int i
313 pprImm (ImmInteger i) = integer i
314 pprImm (ImmCLbl l) = pprCLabel_asm l
315 pprImm (ImmLit s) = s
317 pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s
320 #if sparc_TARGET_ARCH
322 = hcat [ pp_lo, pprImm i, rparen ]
324 pp_lo = ptext (pACK_STR (a_HASH "%lo("#))
327 = hcat [ pp_hi, pprImm i, rparen ]
329 pp_hi = ptext (pACK_STR (a_HASH "%hi("#))
333 %************************************************************************
335 \subsection{@pprAddr@: print an @Addr@}
337 %************************************************************************
340 pprAddr :: Addr -> Doc
342 #if alpha_TARGET_ARCH
343 pprAddr (AddrReg r) = parens (pprReg r)
344 pprAddr (AddrImm i) = pprImm i
345 pprAddr (AddrRegImm r1 i)
346 = (<>) (pprImm i) (parens (pprReg r1))
352 pprAddr (ImmAddr imm off)
358 else if (off < 0) then
359 (<>) pp_imm (int off)
361 hcat [pp_imm, char '+', int off]
363 pprAddr (Addr base index displacement)
365 pp_disp = ppr_disp displacement
366 pp_off p = (<>) pp_disp (parens p)
367 pp_reg r = pprReg L r
370 (Nothing, Nothing) -> pp_disp
371 (Just b, Nothing) -> pp_off (pp_reg b)
372 (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i])
373 (Just b, Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i])
375 ppr_disp (ImmInt 0) = empty
376 ppr_disp imm = pprImm imm
381 #if sparc_TARGET_ARCH
382 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
384 pprAddr (AddrRegReg r1 r2)
385 = hcat [ pprReg r1, char '+', pprReg r2 ]
387 pprAddr (AddrRegImm r1 (ImmInt i))
389 | not (fits13Bits i) = largeOffsetError i
390 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
392 pp_sign = if i > 0 then char '+' else empty
394 pprAddr (AddrRegImm r1 (ImmInteger i))
396 | not (fits13Bits i) = largeOffsetError i
397 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
399 pp_sign = if i > 0 then char '+' else empty
401 pprAddr (AddrRegImm r1 imm)
402 = hcat [ pprReg r1, char '+', pprImm imm ]
406 %************************************************************************
408 \subsection{@pprInstr@: print an @Instr@}
410 %************************************************************************
413 pprInstr :: Instr -> Doc
415 pprInstr (COMMENT s) = empty -- nuke 'em
416 --alpha: = (<>) (ptext SLIT("\t# ")) (ptext s)
417 --i386 : = (<>) (ptext SLIT("# ")) (ptext s)
418 --sparc: = (<>) (ptext SLIT("! ")) (ptext s)
420 pprInstr (SEGMENT TextSegment)
422 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
423 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
424 ,IF_ARCH_i386((_PK_ ".text\n\t.align 2\x2c\&0x90") {-needs per-OS variation!-}
427 pprInstr (SEGMENT DataSegment)
429 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
430 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
431 ,IF_ARCH_i386(SLIT(".data\n\t.align 2")
434 pprInstr (LABEL clab)
436 pp_lab = pprCLabel_asm clab
439 if not (externallyVisibleCLabel clab) then
443 IF_ARCH_alpha(SLIT("\t.globl\t")
444 ,IF_ARCH_i386(SLIT(".globl ")
445 ,IF_ARCH_sparc(SLIT("\t.global\t")
447 , pp_lab, char '\n'],
452 pprInstr (ASCII False{-no backslash conversion-} str)
453 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
455 pprInstr (ASCII True str)
456 = (<>) (text "\t.ascii \"") (asciify str 60)
458 asciify :: String -> Int -> Doc
460 asciify [] _ = text "\\0\""
461 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
462 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
463 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
464 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
465 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\""))
466 asciify (c:(cs@(d:_))) n
467 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
468 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
471 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
474 #if alpha_TARGET_ARCH
475 B -> SLIT("\t.byte\t")
476 BU -> SLIT("\t.byte\t")
477 --UNUSED: W -> SLIT("\t.word\t")
478 --UNUSED: WU -> SLIT("\t.word\t")
479 --UNUSED: L -> SLIT("\t.long\t")
480 Q -> SLIT("\t.quad\t")
481 --UNUSED: FF -> SLIT("\t.f_floating\t")
482 --UNUSED: DF -> SLIT("\t.d_floating\t")
483 --UNUSED: GF -> SLIT("\t.g_floating\t")
484 --UNUSED: SF -> SLIT("\t.s_floating\t")
485 TF -> SLIT("\t.t_floating\t")
488 B -> SLIT("\t.byte\t")
489 --UNUSED: HB -> SLIT("\t.byte\t")
490 --UNUSED: S -> SLIT("\t.word\t")
491 L -> SLIT("\t.long\t")
492 F -> SLIT("\t.long\t")
493 DF -> SLIT("\t.double\t")
495 #if sparc_TARGET_ARCH
496 B -> SLIT("\t.byte\t")
497 BU -> SLIT("\t.byte\t")
498 W -> SLIT("\t.word\t")
499 DF -> SLIT("\t.double\t")
502 -- fall through to rest of (machine-specific) pprInstr...
505 %************************************************************************
507 \subsubsection{@pprInstr@ for an Alpha}
509 %************************************************************************
512 #if alpha_TARGET_ARCH
514 pprInstr (LD size reg addr)
524 pprInstr (LDA reg addr)
526 ptext SLIT("\tlda\t"),
532 pprInstr (LDAH reg addr)
534 ptext SLIT("\tldah\t"),
540 pprInstr (LDGP reg addr)
542 ptext SLIT("\tldgp\t"),
548 pprInstr (LDI size reg imm)
558 pprInstr (ST size reg addr)
570 ptext SLIT("\tclr\t"),
574 pprInstr (ABS size ri reg)
584 pprInstr (NEG size ov ri reg)
588 if ov then ptext SLIT("v\t") else char '\t',
594 pprInstr (ADD size ov reg1 ri reg2)
598 if ov then ptext SLIT("v\t") else char '\t',
606 pprInstr (SADD size scale reg1 ri reg2)
608 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
619 pprInstr (SUB size ov reg1 ri reg2)
623 if ov then ptext SLIT("v\t") else char '\t',
631 pprInstr (SSUB size scale reg1 ri reg2)
633 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
644 pprInstr (MUL size ov reg1 ri reg2)
648 if ov then ptext SLIT("v\t") else char '\t',
656 pprInstr (DIV size uns reg1 ri reg2)
660 if uns then ptext SLIT("u\t") else char '\t',
668 pprInstr (REM size uns reg1 ri reg2)
672 if uns then ptext SLIT("u\t") else char '\t',
680 pprInstr (NOT ri reg)
689 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
690 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
691 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
692 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
693 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
694 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
696 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
697 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
698 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
700 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
701 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
703 pprInstr (NOP) = ptext SLIT("\tnop")
705 pprInstr (CMP cond reg1 ri reg2)
719 ptext SLIT("\tfclr\t"),
723 pprInstr (FABS reg1 reg2)
725 ptext SLIT("\tfabs\t"),
731 pprInstr (FNEG size reg1 reg2)
741 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
742 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
743 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
744 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
746 pprInstr (CVTxy size1 size2 reg1 reg2)
750 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
757 pprInstr (FCMP size cond reg1 reg2 reg3)
770 pprInstr (FMOV reg1 reg2)
772 ptext SLIT("\tfmov\t"),
778 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
780 pprInstr (BI NEVER reg lab) = empty
782 pprInstr (BI cond reg lab)
792 pprInstr (BF cond reg lab)
803 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
805 pprInstr (JMP reg addr hint)
807 ptext SLIT("\tjmp\t"),
816 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
818 pprInstr (JSR reg addr n)
820 ptext SLIT("\tjsr\t"),
826 pprInstr (FUNBEGIN clab)
828 if (externallyVisibleCLabel clab) then
829 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
832 ptext SLIT("\t.ent "),
841 pp_lab = pprCLabel_asm clab
843 pp_ldgp = ptext (pACK_STR (a_HASH ":\n\tldgp $29,0($27)\n"#))
844 pp_frame = ptext (pACK_STR (a_HASH "..ng:\n\t.frame $30,4240,$26,0\n\t.prologue 1"#))
846 pprInstr (FUNEND clab)
847 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
850 Continue with Alpha-only printing bits and bobs:
854 pprRI (RIReg r) = pprReg r
855 pprRI (RIImm r) = pprImm r
857 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> Doc
859 pprRegRIReg name reg1 ri reg2
871 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
873 pprSizeRegRegReg name size reg1 reg2 reg3
886 #endif {-alpha_TARGET_ARCH-}
889 %************************************************************************
891 \subsubsection{@pprInstr@ for an I386}
893 %************************************************************************
898 pprInstr (MOV size (OpReg src) (OpReg dst)) -- hack
901 pprInstr (MOV size src dst)
902 = pprSizeOpOp SLIT("mov") size src dst
903 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
904 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
906 -- here we do some patching, since the physical registers are only set late
907 -- in the code generation.
908 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
910 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
911 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
913 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
914 pprInstr (LEA size (OpAddr (Addr src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
916 = pprInstr (ADD size (OpImm displ) dst)
917 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
919 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
920 = pprSizeOp SLIT("dec") size dst
921 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
922 = pprSizeOp SLIT("inc") size dst
923 pprInstr (ADD size src dst)
924 = pprSizeOpOp SLIT("add") size src dst
925 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
926 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
927 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
929 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
930 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
931 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
932 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
933 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
934 pprInstr (SHL size imm dst) = pprSizeOpOp SLIT("shl") size imm dst
935 pprInstr (SAR size imm dst) = pprSizeOpOp SLIT("sar") size imm dst
936 pprInstr (SHR size imm dst) = pprSizeOpOp SLIT("shr") size imm dst
938 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
939 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
940 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
941 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
943 pprInstr (NOP) = ptext SLIT("\tnop")
944 pprInstr (CLTD) = ptext SLIT("\tcltd")
946 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
948 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
950 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
951 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
954 = hcat [ ptext SLIT("\tcall "), pprImm imm ]
956 pprInstr SAHF = ptext SLIT("\tsahf")
957 pprInstr FABS = ptext SLIT("\tfabs")
959 pprInstr (FADD sz src@(OpAddr _))
960 = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
961 pprInstr (FADD sz src)
962 = ptext SLIT("\tfadd")
964 = ptext SLIT("\tfaddp")
965 pprInstr (FMUL sz src)
966 = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
968 = ptext SLIT("\tfmulp")
969 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
970 pprInstr FCHS = ptext SLIT("\tfchs")
971 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
972 pprInstr FCOS = ptext SLIT("\tfcos")
973 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
974 pprInstr (FDIV sz src)
975 = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
977 = ptext SLIT("\tfdivp")
978 pprInstr (FDIVR sz src)
979 = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
981 = ptext SLIT("\tfdivpr")
982 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
983 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
984 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
985 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
986 pprInstr (FLD sz (OpImm (ImmCLbl src)))
987 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
988 pprInstr (FLD sz src)
989 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
990 pprInstr FLD1 = ptext SLIT("\tfld1")
991 pprInstr FLDZ = ptext SLIT("\tfldz")
992 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
993 pprInstr FRNDINT = ptext SLIT("\tfrndint")
994 pprInstr FSIN = ptext SLIT("\tfsin")
995 pprInstr FSQRT = ptext SLIT("\tfsqrt")
996 pprInstr (FST sz dst)
997 = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
998 pprInstr (FSTP sz dst)
999 = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
1000 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
1001 pprInstr (FSUB sz src)
1002 = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
1004 = ptext SLIT("\tfsubp")
1005 pprInstr (FSUBR size src)
1006 = pprSizeOp SLIT("fsubr") size src
1008 = ptext SLIT("\tfsubpr")
1009 pprInstr (FISUBR size op)
1010 = pprSizeAddr SLIT("fisubr") size op
1011 pprInstr FTST = ptext SLIT("\tftst")
1012 pprInstr (FCOMP sz op)
1013 = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
1014 pprInstr FUCOMPP = ptext SLIT("\tfucompp")
1015 pprInstr FXCH = ptext SLIT("\tfxch")
1016 pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
1017 pprInstr FNOP = ptext SLIT("")
1020 Continue with I386-only printing bits and bobs:
1022 pprDollImm :: Imm -> Doc
1024 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1026 pprOperand :: Size -> Operand -> Doc
1027 pprOperand s (OpReg r) = pprReg s r
1028 pprOperand s (OpImm i) = pprDollImm i
1029 pprOperand s (OpAddr ea) = pprAddr ea
1031 pprSizeOp :: FAST_STRING -> Size -> Operand -> Doc
1032 pprSizeOp name size op1
1041 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1042 pprSizeOpOp name size op1 op2
1048 pprOperand size op1,
1053 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> Doc
1054 pprSizeOpReg name size op1 reg
1060 pprOperand size op1,
1065 pprSizeAddr :: FAST_STRING -> Size -> Addr -> Doc
1066 pprSizeAddr name size op
1075 pprSizeAddrReg :: FAST_STRING -> Size -> Addr -> Reg -> Doc
1076 pprSizeAddrReg name size op dst
1087 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> Doc
1088 pprOpOp name size op1 op2
1092 pprOperand size op1,
1097 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> Doc
1098 pprSizeOpOpCoerce name size1 size2 op1 op2
1099 = hcat [ char '\t', ptext name, space,
1100 pprOperand size1 op1,
1102 pprOperand size2 op2
1105 pprCondInstr :: FAST_STRING -> Cond -> Doc -> Doc
1106 pprCondInstr name cond arg
1107 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1109 #endif {-i386_TARGET_ARCH-}
1112 %************************************************************************
1114 \subsubsection{@pprInstr@ for a SPARC}
1116 %************************************************************************
1119 #if sparc_TARGET_ARCH
1121 -- a clumsy hack for now, to handle possible double alignment problems
1123 -- even clumsier, to allow for RegReg regs that show when doing indexed
1124 -- reads (bytearrays).
1126 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1128 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1129 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1130 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1133 pprInstr (LD DF addr reg) | maybeToBool off_addr
1147 off_addr = addrOffset addr 4
1148 addr2 = case off_addr of Just x -> x
1150 pprInstr (LD size addr reg)
1161 -- The same clumsy hack as above
1163 pprInstr (ST DF reg (AddrRegReg g1 g2))
1165 ptext SLIT("\tadd\t"),
1166 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1167 ptext SLIT("\tst\t"),
1168 pprReg reg, pp_comma_lbracket, pprReg g1,
1169 ptext SLIT("]\n\tst\t"),
1170 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1173 pprInstr (ST DF reg addr) | maybeToBool off_addr
1175 ptext SLIT("\tst\t"),
1176 pprReg reg, pp_comma_lbracket, pprAddr addr,
1178 ptext SLIT("]\n\tst\t"),
1179 pprReg (fPair reg), pp_comma_lbracket,
1180 pprAddr addr2, rbrack
1183 off_addr = addrOffset addr 4
1184 addr2 = case off_addr of Just x -> x
1186 -- no distinction is made between signed and unsigned bytes on stores for the
1187 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1188 -- so we call a special-purpose pprSize for ST..
1190 pprInstr (ST size reg addr)
1201 pprInstr (ADD x cc reg1 ri reg2)
1202 | not x && not cc && riZero ri
1203 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1205 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1207 pprInstr (SUB x cc reg1 ri reg2)
1208 | not x && cc && reg2 == g0
1209 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1210 | not x && not cc && riZero ri
1211 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1213 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1215 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1216 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1218 pprInstr (OR b reg1 ri reg2)
1219 | not b && reg1 == g0
1220 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1222 = pprRegRIReg SLIT("or") b reg1 ri reg2
1224 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1226 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1227 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1229 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1230 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1231 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1233 pprInstr (SETHI imm reg)
1235 ptext SLIT("\tsethi\t"),
1241 pprInstr NOP = ptext SLIT("\tnop")
1243 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1244 pprInstr (FABS DF reg1 reg2)
1245 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1246 (if (reg1 == reg2) then empty
1247 else (<>) (char '\n')
1248 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1250 pprInstr (FADD size reg1 reg2 reg3)
1251 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1252 pprInstr (FCMP e size reg1 reg2)
1253 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1254 pprInstr (FDIV size reg1 reg2 reg3)
1255 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1257 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1258 pprInstr (FMOV DF reg1 reg2)
1259 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1260 (if (reg1 == reg2) then empty
1261 else (<>) (char '\n')
1262 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1264 pprInstr (FMUL size reg1 reg2 reg3)
1265 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1267 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1268 pprInstr (FNEG DF reg1 reg2)
1269 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1270 (if (reg1 == reg2) then empty
1271 else (<>) (char '\n')
1272 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1274 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1275 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1276 pprInstr (FxTOy size1 size2 reg1 reg2)
1289 pprReg reg1, comma, pprReg reg2
1293 pprInstr (BI cond b lab)
1295 ptext SLIT("\tb"), pprCond cond,
1296 if b then pp_comma_a else empty,
1301 pprInstr (BF cond b lab)
1303 ptext SLIT("\tfb"), pprCond cond,
1304 if b then pp_comma_a else empty,
1309 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1311 pprInstr (CALL imm n _)
1312 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1315 Continue with SPARC-only printing bits and bobs:
1318 pprRI (RIReg r) = pprReg r
1319 pprRI (RIImm r) = pprImm r
1321 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Doc
1322 pprSizeRegReg name size reg1 reg2
1327 F -> ptext SLIT("s\t")
1328 DF -> ptext SLIT("d\t")),
1334 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> Doc
1335 pprSizeRegRegReg name size reg1 reg2 reg3
1340 F -> ptext SLIT("s\t")
1341 DF -> ptext SLIT("d\t")),
1349 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> Doc
1350 pprRegRIReg name b reg1 ri reg2
1354 if b then ptext SLIT("cc\t") else char '\t',
1362 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> Doc
1363 pprRIReg name b ri reg1
1367 if b then ptext SLIT("cc\t") else char '\t',
1373 pp_ld_lbracket = ptext (pACK_STR (a_HASH "\tld\t["#))
1374 pp_rbracket_comma = ptext (pACK_STR (a_HASH "],"#))
1375 pp_comma_lbracket = ptext (pACK_STR (a_HASH ",["#))
1376 pp_comma_a = ptext (pACK_STR (a_HASH ",a"#))
1378 #endif {-sparc_TARGET_ARCH-}