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) = (<>) (ptext SLIT("# ")) (ptext s)
398 pprInstr (COMMENT s) = empty -- nuke 'em
399 --alpha: = (<>) (ptext SLIT("\t# ")) (ptext s)
400 --i386 : = (<>) (ptext SLIT("# ")) (ptext s)
401 --sparc: = (<>) (ptext SLIT("! ")) (ptext s)
403 pprInstr (SEGMENT TextSegment)
405 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
406 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
407 ,IF_ARCH_i386((_PK_ ".text\n\t.align 4") {-needs per-OS variation!-}
410 pprInstr (SEGMENT DataSegment)
412 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
413 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
414 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
417 pprInstr (LABEL clab)
419 pp_lab = pprCLabel_asm clab
422 if not (externallyVisibleCLabel clab) then
426 IF_ARCH_alpha(SLIT("\t.globl\t")
427 ,IF_ARCH_i386(SLIT(".globl ")
428 ,IF_ARCH_sparc(SLIT("\t.global\t")
430 , pp_lab, char '\n'],
435 pprInstr (ASCII False{-no backslash conversion-} str)
436 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
438 pprInstr (ASCII True str)
439 = (<>) (text "\t.ascii \"") (asciify str 60)
441 asciify :: String -> Int -> SDoc
443 asciify [] _ = text "\\0\""
444 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
445 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
446 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
447 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
448 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-}
449 asciify (c:(cs@(d:_))) n
450 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
451 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
455 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
458 #if alpha_TARGET_ARCH
459 B -> SLIT("\t.byte\t")
460 BU -> SLIT("\t.byte\t")
461 Q -> SLIT("\t.quad\t")
462 TF -> SLIT("\t.t_floating\t")
465 B -> SLIT("\t.byte\t")
466 L -> SLIT("\t.long\t")
467 F -> SLIT("\t.float\t")
468 DF -> SLIT("\t.double\t")
470 #if sparc_TARGET_ARCH
471 B -> SLIT("\t.byte\t")
472 BU -> SLIT("\t.byte\t")
473 W -> SLIT("\t.word\t")
474 DF -> SLIT("\t.double\t")
480 = vcat (concatMap (ppr_item s) xs)
482 #if alpha_TARGET_ARCH
483 This needs to be fixed.
484 B -> SLIT("\t.byte\t")
485 BU -> SLIT("\t.byte\t")
486 Q -> SLIT("\t.quad\t")
487 TF -> SLIT("\t.t_floating\t")
490 ppr_item B x = [text "\t.byte\t" <> pprImm x]
491 ppr_item L x = [text "\t.long\t" <> pprImm x]
492 ppr_item F (ImmDouble r)
493 = let bs = floatToBytes (fromRational r)
494 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
495 ppr_item DF (ImmDouble r)
496 = let bs = doubleToBytes (fromRational r)
497 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
499 floatToBytes :: Float -> [Int]
502 arr <- newFloatArray ((0::Int),3)
503 writeFloatArray arr 0 f
504 i0 <- readCharArray arr 0
505 i1 <- readCharArray arr 1
506 i2 <- readCharArray arr 2
507 i3 <- readCharArray arr 3
508 return (map ord [i0,i1,i2,i3])
511 doubleToBytes :: Double -> [Int]
514 arr <- newDoubleArray ((0::Int),7)
515 writeDoubleArray arr 0 d
516 i0 <- readCharArray arr 0
517 i1 <- readCharArray arr 1
518 i2 <- readCharArray arr 2
519 i3 <- readCharArray arr 3
520 i4 <- readCharArray arr 4
521 i5 <- readCharArray arr 5
522 i6 <- readCharArray arr 6
523 i7 <- readCharArray arr 7
524 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
528 #if sparc_TARGET_ARCH
529 This needs to be fixed.
530 B -> SLIT("\t.byte\t")
531 BU -> SLIT("\t.byte\t")
532 W -> SLIT("\t.word\t")
533 DF -> SLIT("\t.double\t")
536 -- fall through to rest of (machine-specific) pprInstr...
539 %************************************************************************
541 \subsubsection{@pprInstr@ for an Alpha}
543 %************************************************************************
546 #if alpha_TARGET_ARCH
548 pprInstr (LD size reg addr)
558 pprInstr (LDA reg addr)
560 ptext SLIT("\tlda\t"),
566 pprInstr (LDAH reg addr)
568 ptext SLIT("\tldah\t"),
574 pprInstr (LDGP reg addr)
576 ptext SLIT("\tldgp\t"),
582 pprInstr (LDI size reg imm)
592 pprInstr (ST size reg addr)
604 ptext SLIT("\tclr\t"),
608 pprInstr (ABS size ri reg)
618 pprInstr (NEG size ov ri reg)
622 if ov then ptext SLIT("v\t") else char '\t',
628 pprInstr (ADD size ov reg1 ri reg2)
632 if ov then ptext SLIT("v\t") else char '\t',
640 pprInstr (SADD size scale reg1 ri reg2)
642 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
653 pprInstr (SUB size ov reg1 ri reg2)
657 if ov then ptext SLIT("v\t") else char '\t',
665 pprInstr (SSUB size scale reg1 ri reg2)
667 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
678 pprInstr (MUL size ov reg1 ri reg2)
682 if ov then ptext SLIT("v\t") else char '\t',
690 pprInstr (DIV size uns reg1 ri reg2)
694 if uns then ptext SLIT("u\t") else char '\t',
702 pprInstr (REM size uns reg1 ri reg2)
706 if uns then ptext SLIT("u\t") else char '\t',
714 pprInstr (NOT ri reg)
723 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
724 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
725 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
726 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
727 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
728 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
730 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
731 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
732 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
734 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
735 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
737 pprInstr (NOP) = ptext SLIT("\tnop")
739 pprInstr (CMP cond reg1 ri reg2)
753 ptext SLIT("\tfclr\t"),
757 pprInstr (FABS reg1 reg2)
759 ptext SLIT("\tfabs\t"),
765 pprInstr (FNEG size reg1 reg2)
775 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
776 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
777 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
778 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
780 pprInstr (CVTxy size1 size2 reg1 reg2)
784 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
791 pprInstr (FCMP size cond reg1 reg2 reg3)
804 pprInstr (FMOV reg1 reg2)
806 ptext SLIT("\tfmov\t"),
812 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
814 pprInstr (BI NEVER reg lab) = empty
816 pprInstr (BI cond reg lab)
826 pprInstr (BF cond reg lab)
837 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
839 pprInstr (JMP reg addr hint)
841 ptext SLIT("\tjmp\t"),
850 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
852 pprInstr (JSR reg addr n)
854 ptext SLIT("\tjsr\t"),
860 pprInstr (FUNBEGIN clab)
862 if (externallyVisibleCLabel clab) then
863 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
866 ptext SLIT("\t.ent "),
875 pp_lab = pprCLabel_asm clab
877 -- NEVER use commas within those string literals, cpp will ruin your day
878 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
879 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
880 ptext SLIT("4240"), char ',',
881 ptext SLIT("$26"), char ',',
882 ptext SLIT("0\n\t.prologue 1") ]
884 pprInstr (FUNEND clab)
885 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
888 Continue with Alpha-only printing bits and bobs:
892 pprRI (RIReg r) = pprReg r
893 pprRI (RIImm r) = pprImm r
895 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
897 pprRegRIReg name reg1 ri reg2
909 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
911 pprSizeRegRegReg name size reg1 reg2 reg3
924 #endif {-alpha_TARGET_ARCH-}
927 %************************************************************************
929 \subsubsection{@pprInstr@ for an I386}
931 %************************************************************************
936 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
940 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
944 pprInstr (MOV size src dst)
945 = pprSizeOpOp SLIT("mov") size src dst
946 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
947 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
949 -- here we do some patching, since the physical registers are only set late
950 -- in the code generation.
951 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
953 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
954 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
956 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
957 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
959 = pprInstr (ADD size (OpImm displ) dst)
960 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
962 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
963 = pprSizeOp SLIT("dec") size dst
964 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
965 = pprSizeOp SLIT("inc") size dst
966 pprInstr (ADD size src dst)
967 = pprSizeOpOp SLIT("add") size src dst
968 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
969 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
970 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
972 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
973 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
974 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
975 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
976 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
978 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
979 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
980 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
982 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
983 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
984 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
985 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
987 pprInstr (NOP) = ptext SLIT("\tnop")
988 pprInstr (CLTD) = ptext SLIT("\tcltd")
990 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
992 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
994 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
995 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
998 = hcat [ ptext SLIT("\tcall "), pprImm imm ]
1000 pprInstr SAHF = ptext SLIT("\tsahf")
1001 pprInstr FABS = ptext SLIT("\tfabs")
1003 pprInstr (FADD sz src@(OpAddr _))
1004 = hcat [ptext SLIT("\tfadd"), pprSize sz, space, pprOperand sz src]
1005 pprInstr (FADD sz src)
1006 = ptext SLIT("\tfadd")
1008 = ptext SLIT("\tfaddp")
1009 pprInstr (FMUL sz src)
1010 = hcat [ptext SLIT("\tfmul"), pprSize sz, space, pprOperand sz src]
1012 = ptext SLIT("\tfmulp")
1013 pprInstr (FIADD size op) = pprSizeAddr SLIT("fiadd") size op
1014 pprInstr FCHS = ptext SLIT("\tfchs")
1015 pprInstr (FCOM size op) = pprSizeOp SLIT("fcom") size op
1016 pprInstr FCOS = ptext SLIT("\tfcos")
1017 pprInstr (FIDIV size op) = pprSizeAddr SLIT("fidiv") size op
1018 pprInstr (FDIV sz src)
1019 = hcat [ptext SLIT("\tfdiv"), pprSize sz, space, pprOperand sz src]
1021 = ptext SLIT("\tfdivp")
1022 pprInstr (FDIVR sz src)
1023 = hcat [ptext SLIT("\tfdivr"), pprSize sz, space, pprOperand sz src]
1025 = ptext SLIT("\tfdivpr")
1026 pprInstr (FIDIVR size op) = pprSizeAddr SLIT("fidivr") size op
1027 pprInstr (FICOM size op) = pprSizeAddr SLIT("ficom") size op
1028 pprInstr (FILD sz op reg) = pprSizeAddrReg SLIT("fild") sz op reg
1029 pprInstr (FIST size op) = pprSizeAddr SLIT("fist") size op
1030 pprInstr (FLD sz (OpImm (ImmCLbl src)))
1031 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprCLabel_asm src]
1032 pprInstr (FLD sz src)
1033 = hcat [ptext SLIT("\tfld"),pprSize sz,space,pprOperand sz src]
1034 pprInstr FLD1 = ptext SLIT("\tfld1")
1035 pprInstr FLDZ = ptext SLIT("\tfldz")
1036 pprInstr (FIMUL size op) = pprSizeAddr SLIT("fimul") size op
1037 pprInstr FRNDINT = ptext SLIT("\tfrndint")
1038 pprInstr FSIN = ptext SLIT("\tfsin")
1039 pprInstr FSQRT = ptext SLIT("\tfsqrt")
1040 pprInstr (FST sz dst)
1041 = hcat [ptext SLIT("\tfst"), pprSize sz, space, pprOperand sz dst]
1042 pprInstr (FSTP sz dst)
1043 = hcat [ptext SLIT("\tfstp"), pprSize sz, space, pprOperand sz dst]
1044 pprInstr (FISUB size op) = pprSizeAddr SLIT("fisub") size op
1045 pprInstr (FSUB sz src)
1046 = hcat [ptext SLIT("\tfsub"), pprSize sz, space, pprOperand sz src]
1048 = ptext SLIT("\tfsubp")
1049 pprInstr (FSUBR size src)
1050 = pprSizeOp SLIT("fsubr") size src
1052 = ptext SLIT("\tfsubpr")
1053 pprInstr (FISUBR size op)
1054 = pprSizeAddr SLIT("fisubr") size op
1055 pprInstr FTST = ptext SLIT("\tftst")
1056 pprInstr (FCOMP sz op)
1057 = hcat [ptext SLIT("\tfcomp"), pprSize sz, space, pprOperand sz op]
1058 pprInstr FUCOMPP = ptext SLIT("\tfucompp")
1059 pprInstr FXCH = ptext SLIT("\tfxch")
1060 pprInstr FNSTSW = ptext SLIT("\tfnstsw %ax")
1061 pprInstr FNOP = ptext SLIT("")
1064 Continue with I386-only printing bits and bobs:
1066 pprDollImm :: Imm -> SDoc
1068 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1070 pprOperand :: Size -> Operand -> SDoc
1071 pprOperand s (OpReg r) = pprReg s r
1072 pprOperand s (OpImm i) = pprDollImm i
1073 pprOperand s (OpAddr ea) = pprAddr ea
1075 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1076 pprSizeOp name size op1
1085 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1086 pprSizeOpOp name size op1 op2
1092 pprOperand size op1,
1097 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1098 pprSizeByteOpOp name size op1 op2
1109 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1110 pprSizeOpReg name size op1 reg
1116 pprOperand size op1,
1121 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1122 pprSizeAddr name size op
1131 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1132 pprSizeAddrReg name size op dst
1143 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1144 pprOpOp name size op1 op2
1148 pprOperand size op1,
1153 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1154 pprSizeOpOpCoerce name size1 size2 op1 op2
1155 = hcat [ char '\t', ptext name, space,
1156 pprOperand size1 op1,
1158 pprOperand size2 op2
1161 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1162 pprCondInstr name cond arg
1163 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1165 #endif {-i386_TARGET_ARCH-}
1168 %************************************************************************
1170 \subsubsection{@pprInstr@ for a SPARC}
1172 %************************************************************************
1175 #if sparc_TARGET_ARCH
1177 -- a clumsy hack for now, to handle possible double alignment problems
1179 -- even clumsier, to allow for RegReg regs that show when doing indexed
1180 -- reads (bytearrays).
1182 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1184 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1185 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1186 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1189 pprInstr (LD DF addr reg) | maybeToBool off_addr
1203 off_addr = addrOffset addr 4
1204 addr2 = case off_addr of Just x -> x
1206 pprInstr (LD size addr reg)
1217 -- The same clumsy hack as above
1219 pprInstr (ST DF reg (AddrRegReg g1 g2))
1221 ptext SLIT("\tadd\t"),
1222 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1223 ptext SLIT("\tst\t"),
1224 pprReg reg, pp_comma_lbracket, pprReg g1,
1225 ptext SLIT("]\n\tst\t"),
1226 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1229 pprInstr (ST DF reg addr) | maybeToBool off_addr
1231 ptext SLIT("\tst\t"),
1232 pprReg reg, pp_comma_lbracket, pprAddr addr,
1234 ptext SLIT("]\n\tst\t"),
1235 pprReg (fPair reg), pp_comma_lbracket,
1236 pprAddr addr2, rbrack
1239 off_addr = addrOffset addr 4
1240 addr2 = case off_addr of Just x -> x
1242 -- no distinction is made between signed and unsigned bytes on stores for the
1243 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1244 -- so we call a special-purpose pprSize for ST..
1246 pprInstr (ST size reg addr)
1257 pprInstr (ADD x cc reg1 ri reg2)
1258 | not x && not cc && riZero ri
1259 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1261 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1263 pprInstr (SUB x cc reg1 ri reg2)
1264 | not x && cc && reg2 == g0
1265 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1266 | not x && not cc && riZero ri
1267 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1269 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1271 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1272 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1274 pprInstr (OR b reg1 ri reg2)
1275 | not b && reg1 == g0
1276 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1278 = pprRegRIReg SLIT("or") b reg1 ri reg2
1280 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1282 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1283 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1285 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1286 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1287 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1289 pprInstr (SETHI imm reg)
1291 ptext SLIT("\tsethi\t"),
1297 pprInstr NOP = ptext SLIT("\tnop")
1299 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1300 pprInstr (FABS DF reg1 reg2)
1301 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1302 (if (reg1 == reg2) then empty
1303 else (<>) (char '\n')
1304 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1306 pprInstr (FADD size reg1 reg2 reg3)
1307 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1308 pprInstr (FCMP e size reg1 reg2)
1309 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1310 pprInstr (FDIV size reg1 reg2 reg3)
1311 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1313 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1314 pprInstr (FMOV DF reg1 reg2)
1315 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1316 (if (reg1 == reg2) then empty
1317 else (<>) (char '\n')
1318 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1320 pprInstr (FMUL size reg1 reg2 reg3)
1321 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1323 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1324 pprInstr (FNEG DF reg1 reg2)
1325 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1326 (if (reg1 == reg2) then empty
1327 else (<>) (char '\n')
1328 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1330 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1331 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1332 pprInstr (FxTOy size1 size2 reg1 reg2)
1345 pprReg reg1, comma, pprReg reg2
1349 pprInstr (BI cond b lab)
1351 ptext SLIT("\tb"), pprCond cond,
1352 if b then pp_comma_a else empty,
1357 pprInstr (BF cond b lab)
1359 ptext SLIT("\tfb"), pprCond cond,
1360 if b then pp_comma_a else empty,
1365 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1367 pprInstr (CALL imm n _)
1368 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1371 Continue with SPARC-only printing bits and bobs:
1374 pprRI (RIReg r) = pprReg r
1375 pprRI (RIImm r) = pprImm r
1377 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1378 pprSizeRegReg name size reg1 reg2
1383 F -> ptext SLIT("s\t")
1384 DF -> ptext SLIT("d\t")),
1390 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1391 pprSizeRegRegReg name size reg1 reg2 reg3
1396 F -> ptext SLIT("s\t")
1397 DF -> ptext SLIT("d\t")),
1405 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1406 pprRegRIReg name b reg1 ri reg2
1410 if b then ptext SLIT("cc\t") else char '\t',
1418 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1419 pprRIReg name b ri reg1
1423 if b then ptext SLIT("cc\t") else char '\t',
1429 pp_ld_lbracket = ptext SLIT("\tld\t[")
1430 pp_rbracket_comma = text "],"
1431 pp_comma_lbracket = text ",["
1432 pp_comma_a = text ",a"
1434 #endif {-sparc_TARGET_ARCH-}