2 % (c) The AQUA Project, Glasgow University, 1996-1998
4 \section[PprMach]{Pretty-printing assembly language}
6 We start with the @pprXXX@s with some cross-platform commonality
7 (e.g., @pprReg@); we conclude with the no-commonality monster,
11 #include "nativeGen/NCG.h"
13 module PprMach ( pprInstr ) where
15 #include "HsVersions.h"
17 import MachRegs -- may differ per-platform
20 import CLabel ( pprCLabel_asm, externallyVisibleCLabel )
21 import CStrings ( charToC )
22 import Maybes ( maybeToBool )
23 import Stix ( CodeSegment(..), StixTree(..) )
24 import Char ( isPrint, isDigit )
32 %************************************************************************
34 \subsection{@pprReg@: print a @Reg@}
36 %************************************************************************
38 For x86, the way we print a register name depends
39 on which bit of it we care about. Yurgh.
41 pprReg :: IF_ARCH_i386(Size ->,) Reg -> SDoc
43 pprReg IF_ARCH_i386(s,) r
45 FixedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
46 MappedReg i -> ppr_reg_no IF_ARCH_i386(s,) i
47 other -> text (show other) -- should only happen when debugging
50 ppr_reg_no :: FAST_REG_NO -> SDoc
53 ILIT( 0) -> SLIT("$0"); ILIT( 1) -> SLIT("$1");
54 ILIT( 2) -> SLIT("$2"); ILIT( 3) -> SLIT("$3");
55 ILIT( 4) -> SLIT("$4"); ILIT( 5) -> SLIT("$5");
56 ILIT( 6) -> SLIT("$6"); ILIT( 7) -> SLIT("$7");
57 ILIT( 8) -> SLIT("$8"); ILIT( 9) -> SLIT("$9");
58 ILIT(10) -> SLIT("$10"); ILIT(11) -> SLIT("$11");
59 ILIT(12) -> SLIT("$12"); ILIT(13) -> SLIT("$13");
60 ILIT(14) -> SLIT("$14"); ILIT(15) -> SLIT("$15");
61 ILIT(16) -> SLIT("$16"); ILIT(17) -> SLIT("$17");
62 ILIT(18) -> SLIT("$18"); ILIT(19) -> SLIT("$19");
63 ILIT(20) -> SLIT("$20"); ILIT(21) -> SLIT("$21");
64 ILIT(22) -> SLIT("$22"); ILIT(23) -> SLIT("$23");
65 ILIT(24) -> SLIT("$24"); ILIT(25) -> SLIT("$25");
66 ILIT(26) -> SLIT("$26"); ILIT(27) -> SLIT("$27");
67 ILIT(28) -> SLIT("$28"); ILIT(29) -> SLIT("$29");
68 ILIT(30) -> SLIT("$30"); ILIT(31) -> SLIT("$31");
69 ILIT(32) -> SLIT("$f0"); ILIT(33) -> SLIT("$f1");
70 ILIT(34) -> SLIT("$f2"); ILIT(35) -> SLIT("$f3");
71 ILIT(36) -> SLIT("$f4"); ILIT(37) -> SLIT("$f5");
72 ILIT(38) -> SLIT("$f6"); ILIT(39) -> SLIT("$f7");
73 ILIT(40) -> SLIT("$f8"); ILIT(41) -> SLIT("$f9");
74 ILIT(42) -> SLIT("$f10"); ILIT(43) -> SLIT("$f11");
75 ILIT(44) -> SLIT("$f12"); ILIT(45) -> SLIT("$f13");
76 ILIT(46) -> SLIT("$f14"); ILIT(47) -> SLIT("$f15");
77 ILIT(48) -> SLIT("$f16"); ILIT(49) -> SLIT("$f17");
78 ILIT(50) -> SLIT("$f18"); ILIT(51) -> SLIT("$f19");
79 ILIT(52) -> SLIT("$f20"); ILIT(53) -> SLIT("$f21");
80 ILIT(54) -> SLIT("$f22"); ILIT(55) -> SLIT("$f23");
81 ILIT(56) -> SLIT("$f24"); ILIT(57) -> SLIT("$f25");
82 ILIT(58) -> SLIT("$f26"); ILIT(59) -> SLIT("$f27");
83 ILIT(60) -> SLIT("$f28"); ILIT(61) -> SLIT("$f29");
84 ILIT(62) -> SLIT("$f30"); ILIT(63) -> SLIT("$f31");
85 _ -> SLIT("very naughty alpha register")
89 ppr_reg_no :: Size -> FAST_REG_NO -> SDoc
90 ppr_reg_no B i = ptext
92 ILIT( 0) -> SLIT("%al"); ILIT( 1) -> SLIT("%bl");
93 ILIT( 2) -> SLIT("%cl"); ILIT( 3) -> SLIT("%dl");
94 _ -> SLIT("very naughty I386 byte register")
98 ppr_reg_no HB i = ptext
100 ILIT( 0) -> SLIT("%ah"); ILIT( 1) -> SLIT("%bh");
101 ILIT( 2) -> SLIT("%ch"); ILIT( 3) -> SLIT("%dh");
102 _ -> SLIT("very naughty I386 high byte register")
107 ppr_reg_no S i = ptext
109 ILIT( 0) -> SLIT("%ax"); ILIT( 1) -> SLIT("%bx");
110 ILIT( 2) -> SLIT("%cx"); ILIT( 3) -> SLIT("%dx");
111 ILIT( 4) -> SLIT("%si"); ILIT( 5) -> SLIT("%di");
112 ILIT( 6) -> SLIT("%bp"); ILIT( 7) -> SLIT("%sp");
113 _ -> SLIT("very naughty I386 word register")
117 ppr_reg_no L i = ptext
119 ILIT( 0) -> SLIT("%eax"); ILIT( 1) -> SLIT("%ebx");
120 ILIT( 2) -> SLIT("%ecx"); ILIT( 3) -> SLIT("%edx");
121 ILIT( 4) -> SLIT("%esi"); ILIT( 5) -> SLIT("%edi");
122 ILIT( 6) -> SLIT("%ebp"); ILIT( 7) -> SLIT("%esp");
123 _ -> SLIT("very naughty I386 double word register")
126 ppr_reg_no F i = ptext
128 --ToDo: rm these (???)
129 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
130 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
131 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
132 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
133 _ -> SLIT("very naughty I386 float register")
136 ppr_reg_no DF i = ptext
138 --ToDo: rm these (???)
139 ILIT( 8) -> SLIT("%st(0)"); ILIT( 9) -> SLIT("%st(1)");
140 ILIT(10) -> SLIT("%st(2)"); ILIT(11) -> SLIT("%st(3)");
141 ILIT(12) -> SLIT("%st(4)"); ILIT(13) -> SLIT("%st(5)");
142 ILIT(14) -> SLIT("%st(6)"); ILIT(15) -> SLIT("%st(7)");
143 _ -> SLIT("very naughty I386 float register")
146 #if sparc_TARGET_ARCH
147 ppr_reg_no :: FAST_REG_NO -> SDoc
150 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
151 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
152 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
153 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
154 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
155 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
156 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
157 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
158 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
159 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
160 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
161 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
162 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
163 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
164 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
165 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
166 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
167 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
168 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
169 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
170 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
171 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
172 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
173 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
174 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
175 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
176 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
177 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
178 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
179 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
180 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
181 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
182 _ -> SLIT("very naughty sparc register")
187 %************************************************************************
189 \subsection{@pprSize@: print a @Size@}
191 %************************************************************************
194 pprSize :: Size -> SDoc
196 pprSize x = ptext (case x of
197 #if alpha_TARGET_ARCH
200 -- W -> SLIT("w") UNUSED
201 -- WU -> SLIT("wu") UNUSED
202 -- L -> SLIT("l") UNUSED
204 -- FF -> SLIT("f") UNUSED
205 -- DF -> SLIT("d") UNUSED
206 -- GF -> SLIT("g") UNUSED
207 -- SF -> SLIT("s") UNUSED
212 -- HB -> SLIT("b") UNUSED
213 -- S -> SLIT("w") UNUSED
218 #if sparc_TARGET_ARCH
221 -- HW -> SLIT("hw") UNUSED
222 -- HWU -> SLIT("uhw") UNUSED
225 -- D -> SLIT("d") UNUSED
228 pprStSize :: Size -> SDoc
229 pprStSize x = ptext (case x of
232 -- HW -> SLIT("hw") UNUSED
233 -- HWU -> SLIT("uhw") UNUSED
236 -- D -> SLIT("d") UNUSED
242 %************************************************************************
244 \subsection{@pprCond@: print a @Cond@}
246 %************************************************************************
249 pprCond :: Cond -> SDoc
251 pprCond c = ptext (case c of {
252 #if alpha_TARGET_ARCH
263 GEU -> SLIT("ae"); LU -> SLIT("b");
264 EQQ -> SLIT("e"); GTT -> SLIT("g");
265 GE -> SLIT("ge"); GU -> SLIT("a");
266 LTT -> SLIT("l"); LE -> SLIT("le");
267 LEU -> SLIT("be"); NE -> SLIT("ne");
268 NEG -> SLIT("s"); POS -> SLIT("ns");
269 ALWAYS -> SLIT("mp") -- hack
271 #if sparc_TARGET_ARCH
272 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
273 GEU -> SLIT("geu"); LU -> SLIT("lu");
274 EQQ -> SLIT("e"); GTT -> SLIT("g");
275 GE -> SLIT("ge"); GU -> SLIT("gu");
276 LTT -> SLIT("l"); LE -> SLIT("le");
277 LEU -> SLIT("leu"); NE -> SLIT("ne");
278 NEG -> SLIT("neg"); POS -> SLIT("pos");
279 VC -> SLIT("vc"); VS -> SLIT("vs")
284 %************************************************************************
286 \subsection{@pprImm@: print an @Imm@}
288 %************************************************************************
291 pprImm :: Imm -> SDoc
293 pprImm (ImmInt i) = int i
294 pprImm (ImmInteger i) = integer i
295 pprImm (ImmCLbl l) = pprCLabel_asm l
296 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
297 pprImm (ImmLit s) = s
299 pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s
302 #if sparc_TARGET_ARCH
304 = hcat [ pp_lo, pprImm i, rparen ]
309 = hcat [ pp_hi, pprImm i, rparen ]
315 %************************************************************************
317 \subsection{@pprAddr@: print an @Addr@}
319 %************************************************************************
322 pprAddr :: MachRegsAddr -> SDoc
324 #if alpha_TARGET_ARCH
325 pprAddr (AddrReg r) = parens (pprReg r)
326 pprAddr (AddrImm i) = pprImm i
327 pprAddr (AddrRegImm r1 i)
328 = (<>) (pprImm i) (parens (pprReg r1))
334 pprAddr (ImmAddr imm off)
340 else if (off < 0) then
341 (<>) pp_imm (int off)
343 hcat [pp_imm, char '+', int off]
345 pprAddr (AddrBaseIndex base index displacement)
347 pp_disp = ppr_disp displacement
348 pp_off p = (<>) pp_disp (parens p)
349 pp_reg r = pprReg L r
352 (Nothing, Nothing) -> pp_disp
353 (Just b, Nothing) -> pp_off (pp_reg b)
354 (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i])
355 (Just b, Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i])
357 ppr_disp (ImmInt 0) = empty
358 ppr_disp imm = pprImm imm
363 #if sparc_TARGET_ARCH
364 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
366 pprAddr (AddrRegReg r1 r2)
367 = hcat [ pprReg r1, char '+', pprReg r2 ]
369 pprAddr (AddrRegImm r1 (ImmInt i))
371 | not (fits13Bits i) = largeOffsetError i
372 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
374 pp_sign = if i > 0 then char '+' else empty
376 pprAddr (AddrRegImm r1 (ImmInteger i))
378 | not (fits13Bits i) = largeOffsetError i
379 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
381 pp_sign = if i > 0 then char '+' else empty
383 pprAddr (AddrRegImm r1 imm)
384 = hcat [ pprReg r1, char '+', pprImm imm ]
388 %************************************************************************
390 \subsection{@pprInstr@: print an @Instr@}
392 %************************************************************************
395 pprInstr :: Instr -> SDoc
397 --pprInstr (COMMENT s) = empty -- nuke 'em
399 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ptext s))
400 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ptext s))
401 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ptext s))
404 pprInstr (SEGMENT TextSegment)
406 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
407 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
408 ,IF_ARCH_i386(SLIT(".text\n\t.align 4") {-needs per-OS variation!-}
411 pprInstr (SEGMENT DataSegment)
413 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
414 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
415 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
418 pprInstr (LABEL clab)
420 pp_lab = pprCLabel_asm clab
423 if not (externallyVisibleCLabel clab) then
427 IF_ARCH_alpha(SLIT("\t.globl\t")
428 ,IF_ARCH_i386(SLIT(".globl ")
429 ,IF_ARCH_sparc(SLIT("\t.global\t")
431 , pp_lab, char '\n'],
436 pprInstr (ASCII False{-no backslash conversion-} str)
437 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
439 pprInstr (ASCII True str)
440 = (<>) (text "\t.ascii \"") (asciify str 60)
442 asciify :: String -> Int -> SDoc
444 asciify [] _ = text "\\0\""
445 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
446 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
447 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
448 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
449 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-}
450 asciify (c:(cs@(d:_))) n
451 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
452 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
456 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
459 #if alpha_TARGET_ARCH
460 B -> SLIT("\t.byte\t")
461 BU -> SLIT("\t.byte\t")
462 Q -> SLIT("\t.quad\t")
463 TF -> SLIT("\t.t_floating\t")
466 B -> SLIT("\t.byte\t")
467 L -> SLIT("\t.long\t")
468 F -> SLIT("\t.float\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")
481 = vcat (concatMap (ppr_item s) xs)
483 #if alpha_TARGET_ARCH
484 This needs to be fixed.
485 B -> SLIT("\t.byte\t")
486 BU -> SLIT("\t.byte\t")
487 Q -> SLIT("\t.quad\t")
488 TF -> SLIT("\t.t_floating\t")
491 ppr_item B x = [text "\t.byte\t" <> pprImm x]
492 ppr_item L x = [text "\t.long\t" <> pprImm x]
493 ppr_item F (ImmDouble r)
494 = let bs = floatToBytes (fromRational r)
495 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
496 ppr_item DF (ImmDouble r)
497 = let bs = doubleToBytes (fromRational r)
498 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
500 floatToBytes :: Float -> [Int]
503 arr <- newFloatArray ((0::Int),3)
504 writeFloatArray arr 0 f
505 i0 <- readCharArray arr 0
506 i1 <- readCharArray arr 1
507 i2 <- readCharArray arr 2
508 i3 <- readCharArray arr 3
509 return (map ord [i0,i1,i2,i3])
512 doubleToBytes :: Double -> [Int]
515 arr <- newDoubleArray ((0::Int),7)
516 writeDoubleArray arr 0 d
517 i0 <- readCharArray arr 0
518 i1 <- readCharArray arr 1
519 i2 <- readCharArray arr 2
520 i3 <- readCharArray arr 3
521 i4 <- readCharArray arr 4
522 i5 <- readCharArray arr 5
523 i6 <- readCharArray arr 6
524 i7 <- readCharArray arr 7
525 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
529 #if sparc_TARGET_ARCH
530 This needs to be fixed.
531 B -> SLIT("\t.byte\t")
532 BU -> SLIT("\t.byte\t")
533 W -> SLIT("\t.word\t")
534 DF -> SLIT("\t.double\t")
537 -- fall through to rest of (machine-specific) pprInstr...
540 %************************************************************************
542 \subsubsection{@pprInstr@ for an Alpha}
544 %************************************************************************
547 #if alpha_TARGET_ARCH
549 pprInstr (LD size reg addr)
559 pprInstr (LDA reg addr)
561 ptext SLIT("\tlda\t"),
567 pprInstr (LDAH reg addr)
569 ptext SLIT("\tldah\t"),
575 pprInstr (LDGP reg addr)
577 ptext SLIT("\tldgp\t"),
583 pprInstr (LDI size reg imm)
593 pprInstr (ST size reg addr)
605 ptext SLIT("\tclr\t"),
609 pprInstr (ABS size ri reg)
619 pprInstr (NEG size ov ri reg)
623 if ov then ptext SLIT("v\t") else char '\t',
629 pprInstr (ADD size ov reg1 ri reg2)
633 if ov then ptext SLIT("v\t") else char '\t',
641 pprInstr (SADD size scale reg1 ri reg2)
643 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
654 pprInstr (SUB size ov reg1 ri reg2)
658 if ov then ptext SLIT("v\t") else char '\t',
666 pprInstr (SSUB size scale reg1 ri reg2)
668 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
679 pprInstr (MUL size ov reg1 ri reg2)
683 if ov then ptext SLIT("v\t") else char '\t',
691 pprInstr (DIV size uns reg1 ri reg2)
695 if uns then ptext SLIT("u\t") else char '\t',
703 pprInstr (REM size uns reg1 ri reg2)
707 if uns then ptext SLIT("u\t") else char '\t',
715 pprInstr (NOT ri reg)
724 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
725 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
726 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
727 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
728 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
729 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
731 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
732 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
733 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
735 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
736 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
738 pprInstr (NOP) = ptext SLIT("\tnop")
740 pprInstr (CMP cond reg1 ri reg2)
754 ptext SLIT("\tfclr\t"),
758 pprInstr (FABS reg1 reg2)
760 ptext SLIT("\tfabs\t"),
766 pprInstr (FNEG size reg1 reg2)
776 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
777 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
778 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
779 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
781 pprInstr (CVTxy size1 size2 reg1 reg2)
785 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
792 pprInstr (FCMP size cond reg1 reg2 reg3)
805 pprInstr (FMOV reg1 reg2)
807 ptext SLIT("\tfmov\t"),
813 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
815 pprInstr (BI NEVER reg lab) = empty
817 pprInstr (BI cond reg lab)
827 pprInstr (BF cond reg lab)
838 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
840 pprInstr (JMP reg addr hint)
842 ptext SLIT("\tjmp\t"),
851 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
853 pprInstr (JSR reg addr n)
855 ptext SLIT("\tjsr\t"),
861 pprInstr (FUNBEGIN clab)
863 if (externallyVisibleCLabel clab) then
864 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
867 ptext SLIT("\t.ent "),
876 pp_lab = pprCLabel_asm clab
878 -- NEVER use commas within those string literals, cpp will ruin your day
879 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
880 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
881 ptext SLIT("4240"), char ',',
882 ptext SLIT("$26"), char ',',
883 ptext SLIT("0\n\t.prologue 1") ]
885 pprInstr (FUNEND clab)
886 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
889 Continue with Alpha-only printing bits and bobs:
893 pprRI (RIReg r) = pprReg r
894 pprRI (RIImm r) = pprImm r
896 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
898 pprRegRIReg name reg1 ri reg2
910 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
912 pprSizeRegRegReg name size reg1 reg2 reg3
925 #endif {-alpha_TARGET_ARCH-}
928 %************************************************************************
930 \subsubsection{@pprInstr@ for an I386}
932 %************************************************************************
937 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
941 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
945 pprInstr (MOV size src dst)
946 = pprSizeOpOp SLIT("mov") size src dst
947 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
948 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
950 -- here we do some patching, since the physical registers are only set late
951 -- in the code generation.
952 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
954 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
955 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
957 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
958 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
960 = pprInstr (ADD size (OpImm displ) dst)
961 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
963 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
964 = pprSizeOp SLIT("dec") size dst
965 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
966 = pprSizeOp SLIT("inc") size dst
967 pprInstr (ADD size src dst)
968 = pprSizeOpOp SLIT("add") size src dst
969 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
970 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
971 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
973 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
974 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
975 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
976 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
977 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
979 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
980 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
981 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
983 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
984 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
985 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
986 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
987 pprInstr PUSHA = ptext SLIT("\tpushal")
988 pprInstr POPA = ptext SLIT("\tpopal")
990 pprInstr (NOP) = ptext SLIT("\tnop")
991 pprInstr (CLTD) = ptext SLIT("\tcltd")
993 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
995 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
997 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
998 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
1001 = hcat [ ptext SLIT("\tcall "), pprImm imm ]
1003 pprInstr SAHF = ptext SLIT("\tsahf")
1004 pprInstr FABS = ptext SLIT("\tfabs")
1006 pprInstr (FADD sz src@(OpAddr _))
1007 = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
1008 pprInstr (FADD sz src)
1009 = ptext SLIT("\tfadd")
1011 = ptext SLIT("\tfaddp")
1012 pprInstr (FMUL sz src)
1013 = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
1015 = ptext SLIT("\tfmulp")
1016 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
1017 pprInstr FCHS = ptext SLIT("\tfchs")
1018 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
1019 pprInstr FCOS = ptext SLIT("\tfcos")
1020 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
1021 pprInstr (FDIV sz src)
1022 = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
1024 = ptext SLIT("\tfdivp")
1025 pprInstr (FDIVR sz src)
1026 = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
1028 = ptext SLIT("\tfdivpr")
1029 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
1030 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
1031 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
1032 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
1033 pprInstr (FLD sz (OpImm (ImmCLbl src)))
1034 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
1035 pprInstr (FLD sz src)
1036 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
1037 pprInstr FLD1 = ptext SLIT("\tfld1")
1038 pprInstr FLDZ = ptext SLIT("\tfldz")
1039 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
1040 pprInstr FRNDINT = ptext SLIT("\tfrndint")
1041 pprInstr FSIN = ptext SLIT("\tfsin")
1042 pprInstr FSQRT = ptext SLIT("\tfsqrt")
1043 pprInstr (FST sz dst)
1044 = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
1045 pprInstr (FSTP sz dst)
1046 = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
1047 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
1048 pprInstr (FSUB sz src)
1049 = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
1051 = ptext SLIT("\tfsubp")
1052 pprInstr (FSUBR size src)
1053 = pprSizeOp SLIT("fsubr") size src
1055 = ptext SLIT("\tfsubpr")
1056 pprInstr (FISUBR size op)
1057 = pprSizeAddr SLIT("fisubr") size op
1058 pprInstr FTST = ptext SLIT("\tftst")
1059 pprInstr (FCOMP sz op)
1060 = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
1061 pprInstr FUCOMPP = ptext SLIT("\tfucompp")
1062 pprInstr FXCH = ptext SLIT("\tfxch")
1063 pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
1064 pprInstr FNOP = ptext SLIT("")
1067 Continue with I386-only printing bits and bobs:
1069 pprDollImm :: Imm -> SDoc
1071 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1073 pprOperand :: Size -> Operand -> SDoc
1074 pprOperand s (OpReg r) = pprReg s r
1075 pprOperand s (OpImm i) = pprDollImm i
1076 pprOperand s (OpAddr ea) = pprAddr ea
1078 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1079 pprSizeOp name size op1
1088 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1089 pprSizeOpOp name size op1 op2
1095 pprOperand size op1,
1100 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1101 pprSizeByteOpOp name size op1 op2
1112 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1113 pprSizeOpReg name size op1 reg
1119 pprOperand size op1,
1124 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1125 pprSizeAddr name size op
1134 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1135 pprSizeAddrReg name size op dst
1146 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1147 pprOpOp name size op1 op2
1151 pprOperand size op1,
1156 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1157 pprSizeOpOpCoerce name size1 size2 op1 op2
1158 = hcat [ char '\t', ptext name, space,
1159 pprOperand size1 op1,
1161 pprOperand size2 op2
1164 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1165 pprCondInstr name cond arg
1166 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1168 #endif {-i386_TARGET_ARCH-}
1171 %************************************************************************
1173 \subsubsection{@pprInstr@ for a SPARC}
1175 %************************************************************************
1178 #if sparc_TARGET_ARCH
1180 -- a clumsy hack for now, to handle possible double alignment problems
1182 -- even clumsier, to allow for RegReg regs that show when doing indexed
1183 -- reads (bytearrays).
1185 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1187 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1188 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1189 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1192 pprInstr (LD DF addr reg) | maybeToBool off_addr
1206 off_addr = addrOffset addr 4
1207 addr2 = case off_addr of Just x -> x
1209 pprInstr (LD size addr reg)
1220 -- The same clumsy hack as above
1222 pprInstr (ST DF reg (AddrRegReg g1 g2))
1224 ptext SLIT("\tadd\t"),
1225 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1226 ptext SLIT("\tst\t"),
1227 pprReg reg, pp_comma_lbracket, pprReg g1,
1228 ptext SLIT("]\n\tst\t"),
1229 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1232 pprInstr (ST DF reg addr) | maybeToBool off_addr
1234 ptext SLIT("\tst\t"),
1235 pprReg reg, pp_comma_lbracket, pprAddr addr,
1237 ptext SLIT("]\n\tst\t"),
1238 pprReg (fPair reg), pp_comma_lbracket,
1239 pprAddr addr2, rbrack
1242 off_addr = addrOffset addr 4
1243 addr2 = case off_addr of Just x -> x
1245 -- no distinction is made between signed and unsigned bytes on stores for the
1246 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1247 -- so we call a special-purpose pprSize for ST..
1249 pprInstr (ST size reg addr)
1260 pprInstr (ADD x cc reg1 ri reg2)
1261 | not x && not cc && riZero ri
1262 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1264 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1266 pprInstr (SUB x cc reg1 ri reg2)
1267 | not x && cc && reg2 == g0
1268 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1269 | not x && not cc && riZero ri
1270 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1272 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1274 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1275 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1277 pprInstr (OR b reg1 ri reg2)
1278 | not b && reg1 == g0
1279 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1281 = pprRegRIReg SLIT("or") b reg1 ri reg2
1283 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1285 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1286 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1288 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1289 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1290 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1292 pprInstr (SETHI imm reg)
1294 ptext SLIT("\tsethi\t"),
1300 pprInstr NOP = ptext SLIT("\tnop")
1302 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1303 pprInstr (FABS DF reg1 reg2)
1304 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1305 (if (reg1 == reg2) then empty
1306 else (<>) (char '\n')
1307 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1309 pprInstr (FADD size reg1 reg2 reg3)
1310 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1311 pprInstr (FCMP e size reg1 reg2)
1312 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1313 pprInstr (FDIV size reg1 reg2 reg3)
1314 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1316 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1317 pprInstr (FMOV DF reg1 reg2)
1318 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1319 (if (reg1 == reg2) then empty
1320 else (<>) (char '\n')
1321 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1323 pprInstr (FMUL size reg1 reg2 reg3)
1324 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1326 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1327 pprInstr (FNEG DF reg1 reg2)
1328 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1329 (if (reg1 == reg2) then empty
1330 else (<>) (char '\n')
1331 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1333 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1334 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1335 pprInstr (FxTOy size1 size2 reg1 reg2)
1348 pprReg reg1, comma, pprReg reg2
1352 pprInstr (BI cond b lab)
1354 ptext SLIT("\tb"), pprCond cond,
1355 if b then pp_comma_a else empty,
1360 pprInstr (BF cond b lab)
1362 ptext SLIT("\tfb"), pprCond cond,
1363 if b then pp_comma_a else empty,
1368 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1370 pprInstr (CALL imm n _)
1371 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1374 Continue with SPARC-only printing bits and bobs:
1377 pprRI (RIReg r) = pprReg r
1378 pprRI (RIImm r) = pprImm r
1380 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1381 pprSizeRegReg name size reg1 reg2
1386 F -> ptext SLIT("s\t")
1387 DF -> ptext SLIT("d\t")),
1393 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1394 pprSizeRegRegReg name size reg1 reg2 reg3
1399 F -> ptext SLIT("s\t")
1400 DF -> ptext SLIT("d\t")),
1408 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1409 pprRegRIReg name b reg1 ri reg2
1413 if b then ptext SLIT("cc\t") else char '\t',
1421 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1422 pprRIReg name b ri reg1
1426 if b then ptext SLIT("cc\t") else char '\t',
1432 pp_ld_lbracket = ptext SLIT("\tld\t[")
1433 pp_rbracket_comma = text "],"
1434 pp_comma_lbracket = text ",["
1435 pp_comma_a = text ",a"
1437 #endif {-sparc_TARGET_ARCH-}