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, pprSize ) 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 ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1");
129 ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3");
130 ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5");
131 _ -> SLIT("very naughty I386 float register")
134 ppr_reg_no DF i = ptext
136 ILIT( 8) -> SLIT("%fake0"); ILIT( 9) -> SLIT("%fake1");
137 ILIT(10) -> SLIT("%fake2"); ILIT(11) -> SLIT("%fake3");
138 ILIT(12) -> SLIT("%fake4"); ILIT(13) -> SLIT("%fake5");
139 _ -> SLIT("very naughty I386 float register")
142 #if sparc_TARGET_ARCH
143 ppr_reg_no :: FAST_REG_NO -> SDoc
146 ILIT( 0) -> SLIT("%g0"); ILIT( 1) -> SLIT("%g1");
147 ILIT( 2) -> SLIT("%g2"); ILIT( 3) -> SLIT("%g3");
148 ILIT( 4) -> SLIT("%g4"); ILIT( 5) -> SLIT("%g5");
149 ILIT( 6) -> SLIT("%g6"); ILIT( 7) -> SLIT("%g7");
150 ILIT( 8) -> SLIT("%o0"); ILIT( 9) -> SLIT("%o1");
151 ILIT(10) -> SLIT("%o2"); ILIT(11) -> SLIT("%o3");
152 ILIT(12) -> SLIT("%o4"); ILIT(13) -> SLIT("%o5");
153 ILIT(14) -> SLIT("%o6"); ILIT(15) -> SLIT("%o7");
154 ILIT(16) -> SLIT("%l0"); ILIT(17) -> SLIT("%l1");
155 ILIT(18) -> SLIT("%l2"); ILIT(19) -> SLIT("%l3");
156 ILIT(20) -> SLIT("%l4"); ILIT(21) -> SLIT("%l5");
157 ILIT(22) -> SLIT("%l6"); ILIT(23) -> SLIT("%l7");
158 ILIT(24) -> SLIT("%i0"); ILIT(25) -> SLIT("%i1");
159 ILIT(26) -> SLIT("%i2"); ILIT(27) -> SLIT("%i3");
160 ILIT(28) -> SLIT("%i4"); ILIT(29) -> SLIT("%i5");
161 ILIT(30) -> SLIT("%i6"); ILIT(31) -> SLIT("%i7");
162 ILIT(32) -> SLIT("%f0"); ILIT(33) -> SLIT("%f1");
163 ILIT(34) -> SLIT("%f2"); ILIT(35) -> SLIT("%f3");
164 ILIT(36) -> SLIT("%f4"); ILIT(37) -> SLIT("%f5");
165 ILIT(38) -> SLIT("%f6"); ILIT(39) -> SLIT("%f7");
166 ILIT(40) -> SLIT("%f8"); ILIT(41) -> SLIT("%f9");
167 ILIT(42) -> SLIT("%f10"); ILIT(43) -> SLIT("%f11");
168 ILIT(44) -> SLIT("%f12"); ILIT(45) -> SLIT("%f13");
169 ILIT(46) -> SLIT("%f14"); ILIT(47) -> SLIT("%f15");
170 ILIT(48) -> SLIT("%f16"); ILIT(49) -> SLIT("%f17");
171 ILIT(50) -> SLIT("%f18"); ILIT(51) -> SLIT("%f19");
172 ILIT(52) -> SLIT("%f20"); ILIT(53) -> SLIT("%f21");
173 ILIT(54) -> SLIT("%f22"); ILIT(55) -> SLIT("%f23");
174 ILIT(56) -> SLIT("%f24"); ILIT(57) -> SLIT("%f25");
175 ILIT(58) -> SLIT("%f26"); ILIT(59) -> SLIT("%f27");
176 ILIT(60) -> SLIT("%f28"); ILIT(61) -> SLIT("%f29");
177 ILIT(62) -> SLIT("%f30"); ILIT(63) -> SLIT("%f31");
178 _ -> SLIT("very naughty sparc register")
183 %************************************************************************
185 \subsection{@pprSize@: print a @Size@}
187 %************************************************************************
190 pprSize :: Size -> SDoc
192 pprSize x = ptext (case x of
193 #if alpha_TARGET_ARCH
196 -- W -> SLIT("w") UNUSED
197 -- WU -> SLIT("wu") UNUSED
198 -- L -> SLIT("l") UNUSED
200 -- FF -> SLIT("f") UNUSED
201 -- DF -> SLIT("d") UNUSED
202 -- GF -> SLIT("g") UNUSED
203 -- SF -> SLIT("s") UNUSED
208 -- HB -> SLIT("b") UNUSED
209 -- S -> SLIT("w") UNUSED
214 #if sparc_TARGET_ARCH
217 -- HW -> SLIT("hw") UNUSED
218 -- HWU -> SLIT("uhw") UNUSED
221 -- D -> SLIT("d") UNUSED
224 pprStSize :: Size -> SDoc
225 pprStSize x = ptext (case x of
228 -- HW -> SLIT("hw") UNUSED
229 -- HWU -> SLIT("uhw") UNUSED
232 -- D -> SLIT("d") UNUSED
238 %************************************************************************
240 \subsection{@pprCond@: print a @Cond@}
242 %************************************************************************
245 pprCond :: Cond -> SDoc
247 pprCond c = ptext (case c of {
248 #if alpha_TARGET_ARCH
259 GEU -> SLIT("ae"); LU -> SLIT("b");
260 EQQ -> SLIT("e"); GTT -> SLIT("g");
261 GE -> SLIT("ge"); GU -> SLIT("a");
262 LTT -> SLIT("l"); LE -> SLIT("le");
263 LEU -> SLIT("be"); NE -> SLIT("ne");
264 NEG -> SLIT("s"); POS -> SLIT("ns");
265 ALWAYS -> SLIT("mp") -- hack
267 #if sparc_TARGET_ARCH
268 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
269 GEU -> SLIT("geu"); LU -> SLIT("lu");
270 EQQ -> SLIT("e"); GTT -> SLIT("g");
271 GE -> SLIT("ge"); GU -> SLIT("gu");
272 LTT -> SLIT("l"); LE -> SLIT("le");
273 LEU -> SLIT("leu"); NE -> SLIT("ne");
274 NEG -> SLIT("neg"); POS -> SLIT("pos");
275 VC -> SLIT("vc"); VS -> SLIT("vs")
280 %************************************************************************
282 \subsection{@pprImm@: print an @Imm@}
284 %************************************************************************
287 pprImm :: Imm -> SDoc
289 pprImm (ImmInt i) = int i
290 pprImm (ImmInteger i) = integer i
291 pprImm (ImmCLbl l) = pprCLabel_asm l
292 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
293 pprImm (ImmLit s) = s
295 pprImm (ImmLab s) | underscorePrefix = (<>) (char '_') s
298 #if sparc_TARGET_ARCH
300 = hcat [ pp_lo, pprImm i, rparen ]
305 = hcat [ pp_hi, pprImm i, rparen ]
311 %************************************************************************
313 \subsection{@pprAddr@: print an @Addr@}
315 %************************************************************************
318 pprAddr :: MachRegsAddr -> SDoc
320 #if alpha_TARGET_ARCH
321 pprAddr (AddrReg r) = parens (pprReg r)
322 pprAddr (AddrImm i) = pprImm i
323 pprAddr (AddrRegImm r1 i)
324 = (<>) (pprImm i) (parens (pprReg r1))
330 pprAddr (ImmAddr imm off)
336 else if (off < 0) then
337 (<>) pp_imm (int off)
339 hcat [pp_imm, char '+', int off]
341 pprAddr (AddrBaseIndex base index displacement)
343 pp_disp = ppr_disp displacement
344 pp_off p = (<>) pp_disp (parens p)
345 pp_reg r = pprReg L r
348 (Nothing, Nothing) -> pp_disp
349 (Just b, Nothing) -> pp_off (pp_reg b)
350 (Nothing, Just (r,i)) -> pp_off (hcat [pp_reg r, comma, int i])
351 (Just b, Just (r,i)) -> pp_off (hcat [pp_reg b, comma, pp_reg r, comma, int i])
353 ppr_disp (ImmInt 0) = empty
354 ppr_disp imm = pprImm imm
359 #if sparc_TARGET_ARCH
360 pprAddr (AddrRegReg r1 (FixedReg ILIT(0))) = pprReg r1
362 pprAddr (AddrRegReg r1 r2)
363 = hcat [ pprReg r1, char '+', pprReg r2 ]
365 pprAddr (AddrRegImm r1 (ImmInt i))
367 | not (fits13Bits i) = largeOffsetError i
368 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
370 pp_sign = if i > 0 then char '+' else empty
372 pprAddr (AddrRegImm r1 (ImmInteger i))
374 | not (fits13Bits i) = largeOffsetError i
375 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
377 pp_sign = if i > 0 then char '+' else empty
379 pprAddr (AddrRegImm r1 imm)
380 = hcat [ pprReg r1, char '+', pprImm imm ]
384 %************************************************************************
386 \subsection{@pprInstr@: print an @Instr@}
388 %************************************************************************
391 pprInstr :: Instr -> SDoc
393 --pprInstr (COMMENT s) = empty -- nuke 'em
395 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ptext s))
396 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ptext s))
397 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ptext s))
400 pprInstr (SEGMENT TextSegment)
401 = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
402 ,IF_ARCH_sparc(ptext SLIT("\t.text\n\t.align 4") {-word boundary-}
403 ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
406 pprInstr (SEGMENT DataSegment)
408 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
409 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
410 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
413 pprInstr (LABEL clab)
415 pp_lab = pprCLabel_asm clab
418 if not (externallyVisibleCLabel clab) then
422 IF_ARCH_alpha(SLIT("\t.globl\t")
423 ,IF_ARCH_i386(SLIT(".globl ")
424 ,IF_ARCH_sparc(SLIT("\t.global\t")
426 , pp_lab, char '\n'],
431 pprInstr (ASCII False{-no backslash conversion-} str)
432 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
434 pprInstr (ASCII True str)
435 = (<>) (text "\t.ascii \"") (asciify str 60)
437 asciify :: String -> Int -> SDoc
439 asciify [] _ = text "\\0\""
440 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
441 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
442 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
443 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
444 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-}
445 asciify (c:(cs@(d:_))) n
446 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
447 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
451 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
454 #if alpha_TARGET_ARCH
455 B -> SLIT("\t.byte\t")
456 BU -> SLIT("\t.byte\t")
457 Q -> SLIT("\t.quad\t")
458 TF -> SLIT("\t.t_floating\t")
461 B -> SLIT("\t.byte\t")
462 L -> SLIT("\t.long\t")
463 F -> SLIT("\t.float\t")
464 DF -> SLIT("\t.double\t")
466 #if sparc_TARGET_ARCH
467 B -> SLIT("\t.byte\t")
468 BU -> SLIT("\t.byte\t")
469 W -> SLIT("\t.word\t")
470 DF -> SLIT("\t.double\t")
476 = vcat (concatMap (ppr_item s) xs)
478 #if alpha_TARGET_ARCH
479 ppr_item = error "ppr_item on Alpha"
481 This needs to be fixed.
482 B -> SLIT("\t.byte\t")
483 BU -> SLIT("\t.byte\t")
484 Q -> SLIT("\t.quad\t")
485 TF -> SLIT("\t.t_floating\t")
488 #if sparc_TARGET_ARCH
489 ppr_item = error "ppr_item on Sparc"
491 This needs to be fixed.
492 B -> SLIT("\t.byte\t")
493 BU -> SLIT("\t.byte\t")
494 W -> SLIT("\t.word\t")
495 DF -> SLIT("\t.double\t")
499 ppr_item B x = [text "\t.byte\t" <> pprImm x]
500 ppr_item L x = [text "\t.long\t" <> pprImm x]
501 ppr_item F (ImmDouble r)
502 = let bs = floatToBytes (fromRational r)
503 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
504 ppr_item DF (ImmDouble r)
505 = let bs = doubleToBytes (fromRational r)
506 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
508 floatToBytes :: Float -> [Int]
511 arr <- newFloatArray ((0::Int),3)
512 writeFloatArray arr 0 f
513 i0 <- readCharArray arr 0
514 i1 <- readCharArray arr 1
515 i2 <- readCharArray arr 2
516 i3 <- readCharArray arr 3
517 return (map ord [i0,i1,i2,i3])
520 doubleToBytes :: Double -> [Int]
523 arr <- newDoubleArray ((0::Int),7)
524 writeDoubleArray arr 0 d
525 i0 <- readCharArray arr 0
526 i1 <- readCharArray arr 1
527 i2 <- readCharArray arr 2
528 i3 <- readCharArray arr 3
529 i4 <- readCharArray arr 4
530 i5 <- readCharArray arr 5
531 i6 <- readCharArray arr 6
532 i7 <- readCharArray arr 7
533 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
538 -- fall through to rest of (machine-specific) pprInstr...
541 %************************************************************************
543 \subsubsection{@pprInstr@ for an Alpha}
545 %************************************************************************
548 #if alpha_TARGET_ARCH
550 pprInstr (LD size reg addr)
560 pprInstr (LDA reg addr)
562 ptext SLIT("\tlda\t"),
568 pprInstr (LDAH reg addr)
570 ptext SLIT("\tldah\t"),
576 pprInstr (LDGP reg addr)
578 ptext SLIT("\tldgp\t"),
584 pprInstr (LDI size reg imm)
594 pprInstr (ST size reg addr)
606 ptext SLIT("\tclr\t"),
610 pprInstr (ABS size ri reg)
620 pprInstr (NEG size ov ri reg)
624 if ov then ptext SLIT("v\t") else char '\t',
630 pprInstr (ADD size ov reg1 ri reg2)
634 if ov then ptext SLIT("v\t") else char '\t',
642 pprInstr (SADD size scale reg1 ri reg2)
644 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
655 pprInstr (SUB size ov reg1 ri reg2)
659 if ov then ptext SLIT("v\t") else char '\t',
667 pprInstr (SSUB size scale reg1 ri reg2)
669 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
680 pprInstr (MUL size ov reg1 ri reg2)
684 if ov then ptext SLIT("v\t") else char '\t',
692 pprInstr (DIV size uns reg1 ri reg2)
696 if uns then ptext SLIT("u\t") else char '\t',
704 pprInstr (REM size uns reg1 ri reg2)
708 if uns then ptext SLIT("u\t") else char '\t',
716 pprInstr (NOT ri reg)
725 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
726 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
727 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
728 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
729 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
730 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
732 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
733 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
734 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
736 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
737 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
739 pprInstr (NOP) = ptext SLIT("\tnop")
741 pprInstr (CMP cond reg1 ri reg2)
755 ptext SLIT("\tfclr\t"),
759 pprInstr (FABS reg1 reg2)
761 ptext SLIT("\tfabs\t"),
767 pprInstr (FNEG size reg1 reg2)
777 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
778 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
779 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
780 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
782 pprInstr (CVTxy size1 size2 reg1 reg2)
786 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
793 pprInstr (FCMP size cond reg1 reg2 reg3)
806 pprInstr (FMOV reg1 reg2)
808 ptext SLIT("\tfmov\t"),
814 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
816 pprInstr (BI NEVER reg lab) = empty
818 pprInstr (BI cond reg lab)
828 pprInstr (BF cond reg lab)
839 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
841 pprInstr (JMP reg addr hint)
843 ptext SLIT("\tjmp\t"),
852 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
854 pprInstr (JSR reg addr n)
856 ptext SLIT("\tjsr\t"),
862 pprInstr (FUNBEGIN clab)
864 if (externallyVisibleCLabel clab) then
865 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
868 ptext SLIT("\t.ent "),
877 pp_lab = pprCLabel_asm clab
879 -- NEVER use commas within those string literals, cpp will ruin your day
880 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
881 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
882 ptext SLIT("4240"), char ',',
883 ptext SLIT("$26"), char ',',
884 ptext SLIT("0\n\t.prologue 1") ]
886 pprInstr (FUNEND clab)
887 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
890 Continue with Alpha-only printing bits and bobs:
894 pprRI (RIReg r) = pprReg r
895 pprRI (RIImm r) = pprImm r
897 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
899 pprRegRIReg name reg1 ri reg2
911 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
913 pprSizeRegRegReg name size reg1 reg2 reg3
926 #endif {-alpha_TARGET_ARCH-}
929 %************************************************************************
931 \subsubsection{@pprInstr@ for an I386}
933 %************************************************************************
938 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
942 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
946 pprInstr (MOV size src dst)
947 = pprSizeOpOp SLIT("mov") size src dst
948 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
949 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
951 -- here we do some patching, since the physical registers are only set late
952 -- in the code generation.
953 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
955 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
956 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
958 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
959 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
961 = pprInstr (ADD size (OpImm displ) dst)
962 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
964 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
965 = pprSizeOp SLIT("dec") size dst
966 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
967 = pprSizeOp SLIT("inc") size dst
968 pprInstr (ADD size src dst)
969 = pprSizeOpOp SLIT("add") size src dst
970 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
971 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
972 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
974 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
975 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
976 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
977 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
978 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
980 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
981 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
982 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
984 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
985 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
986 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
987 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
988 pprInstr PUSHA = ptext SLIT("\tpushal")
989 pprInstr POPA = ptext SLIT("\tpopal")
991 pprInstr (NOP) = ptext SLIT("\tnop")
992 pprInstr (CLTD) = ptext SLIT("\tcltd")
994 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
996 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
998 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
999 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
1001 = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1004 -- Simulating a flat register set on the x86 FP stack is tricky.
1005 -- you have to free %st(7) before pushing anything on the FP reg stack
1006 -- so as to preclude the possibility of a FP stack overflow exception.
1007 pprInstr g@(GMOV src dst)
1011 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1013 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1014 pprInstr g@(GLD sz addr dst)
1015 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1016 pprAddr addr, gsemi, gpop dst 1])
1018 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1019 pprInstr g@(GST sz src addr)
1020 = pprG g (hcat [gtab, gpush src 0, gsemi,
1021 text "fstp", pprSize sz, gsp, pprAddr addr])
1023 pprInstr g@(GFTOD src dst)
1025 pprInstr g@(GFTOI src dst)
1028 pprInstr g@(GDTOF src dst)
1030 pprInstr g@(GDTOI src dst)
1033 pprInstr g@(GITOF src dst)
1035 pprInstr g@(GITOD src dst)
1038 pprInstr g@(GCMP sz src1 src2)
1039 = pprG g (hcat [gtab, text "pushl %eax ; ",
1040 gpush src2 0, gsemi, gpush src1 1]
1042 hcat [gtab, text "fcompp ; fstsw %ax ; sahf ; popl %eax"])
1044 pprInstr g@(GABS sz src dst)
1045 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1046 pprInstr g@(GNEG sz src dst)
1047 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1048 pprInstr g@(GSQRT sz src dst)
1049 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt ; ", gpop dst 1])
1051 pprInstr g@(GADD sz src1 src2 dst)
1052 = pprG g (hcat [gtab, gpush src1 0,
1053 text " ; fadd ", greg src2 1, text ",%st(0)",
1055 pprInstr g@(GSUB sz src1 src2 dst)
1056 = pprG g (hcat [gtab, gpush src1 0,
1057 text " ; fsub ", greg src2 1, text ",%st(0)",
1059 pprInstr g@(GMUL sz src1 src2 dst)
1060 = pprG g (hcat [gtab, gpush src1 0,
1061 text " ; fmul ", greg src2 1, text ",%st(0)",
1063 pprInstr g@(GDIV sz src1 src2 dst)
1064 = pprG g (hcat [gtab, gpush src1 0,
1065 text " ; fdiv ", greg src2 1, text ",%st(0)",
1069 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1070 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1073 --------------------------
1075 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1077 = hcat [text "fstp ", greg reg offset]
1079 bogus = text "\tbogus"
1080 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1084 gregno (FixedReg i) = I# i
1085 gregno (MappedReg i) = I# i
1086 gregno other = pprPanic "gregno" (text (show other))
1088 pprG :: Instr -> SDoc -> SDoc
1090 = (char '#' <> pprGInstr fake) $$ actual
1092 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst
1093 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1094 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1096 pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
1097 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
1099 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
1100 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1102 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
1103 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1105 pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
1106 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1107 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1108 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1110 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1111 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1112 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1113 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1116 Continue with I386-only printing bits and bobs:
1118 pprDollImm :: Imm -> SDoc
1120 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1122 pprOperand :: Size -> Operand -> SDoc
1123 pprOperand s (OpReg r) = pprReg s r
1124 pprOperand s (OpImm i) = pprDollImm i
1125 pprOperand s (OpAddr ea) = pprAddr ea
1127 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1128 pprSizeOp name size op1
1137 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1138 pprSizeOpOp name size op1 op2
1144 pprOperand size op1,
1149 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1150 pprSizeByteOpOp name size op1 op2
1161 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1162 pprSizeOpReg name size op1 reg
1168 pprOperand size op1,
1173 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1174 pprSizeRegReg name size reg1 reg2
1185 pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
1186 pprSizeSizeRegReg name size1 size2 reg1 reg2
1198 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1199 pprSizeRegRegReg name size reg1 reg2 reg3
1212 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1213 pprSizeAddr name size op
1222 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1223 pprSizeAddrReg name size op dst
1234 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
1235 pprSizeRegAddr name size src op
1246 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1247 pprOpOp name size op1 op2
1251 pprOperand size op1,
1256 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1257 pprSizeOpOpCoerce name size1 size2 op1 op2
1258 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1259 pprOperand size1 op1,
1261 pprOperand size2 op2
1264 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1265 pprCondInstr name cond arg
1266 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1268 #endif {-i386_TARGET_ARCH-}
1271 %************************************************************************
1273 \subsubsection{@pprInstr@ for a SPARC}
1275 %************************************************************************
1278 #if sparc_TARGET_ARCH
1280 -- a clumsy hack for now, to handle possible double alignment problems
1282 -- even clumsier, to allow for RegReg regs that show when doing indexed
1283 -- reads (bytearrays).
1285 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1287 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1288 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1289 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1292 pprInstr (LD DF addr reg) | maybeToBool off_addr
1306 off_addr = addrOffset addr 4
1307 addr2 = case off_addr of Just x -> x
1309 pprInstr (LD size addr reg)
1320 -- The same clumsy hack as above
1322 pprInstr (ST DF reg (AddrRegReg g1 g2))
1324 ptext SLIT("\tadd\t"),
1325 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1326 ptext SLIT("\tst\t"),
1327 pprReg reg, pp_comma_lbracket, pprReg g1,
1328 ptext SLIT("]\n\tst\t"),
1329 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1332 pprInstr (ST DF reg addr) | maybeToBool off_addr
1334 ptext SLIT("\tst\t"),
1335 pprReg reg, pp_comma_lbracket, pprAddr addr,
1337 ptext SLIT("]\n\tst\t"),
1338 pprReg (fPair reg), pp_comma_lbracket,
1339 pprAddr addr2, rbrack
1342 off_addr = addrOffset addr 4
1343 addr2 = case off_addr of Just x -> x
1345 -- no distinction is made between signed and unsigned bytes on stores for the
1346 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1347 -- so we call a special-purpose pprSize for ST..
1349 pprInstr (ST size reg addr)
1360 pprInstr (ADD x cc reg1 ri reg2)
1361 | not x && not cc && riZero ri
1362 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1364 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1366 pprInstr (SUB x cc reg1 ri reg2)
1367 | not x && cc && reg2 == g0
1368 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1369 | not x && not cc && riZero ri
1370 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1372 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1374 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1375 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1377 pprInstr (OR b reg1 ri reg2)
1378 | not b && reg1 == g0
1379 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1381 = pprRegRIReg SLIT("or") b reg1 ri reg2
1383 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1385 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1386 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1388 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1389 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1390 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1392 pprInstr (SETHI imm reg)
1394 ptext SLIT("\tsethi\t"),
1400 pprInstr NOP = ptext SLIT("\tnop")
1402 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1403 pprInstr (FABS DF reg1 reg2)
1404 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1405 (if (reg1 == reg2) then empty
1406 else (<>) (char '\n')
1407 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1409 pprInstr (FADD size reg1 reg2 reg3)
1410 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1411 pprInstr (FCMP e size reg1 reg2)
1412 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1413 pprInstr (FDIV size reg1 reg2 reg3)
1414 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1416 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1417 pprInstr (FMOV DF reg1 reg2)
1418 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1419 (if (reg1 == reg2) then empty
1420 else (<>) (char '\n')
1421 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1423 pprInstr (FMUL size reg1 reg2 reg3)
1424 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1426 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1427 pprInstr (FNEG DF reg1 reg2)
1428 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1429 (if (reg1 == reg2) then empty
1430 else (<>) (char '\n')
1431 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1433 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1434 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1435 pprInstr (FxTOy size1 size2 reg1 reg2)
1448 pprReg reg1, comma, pprReg reg2
1452 pprInstr (BI cond b lab)
1454 ptext SLIT("\tb"), pprCond cond,
1455 if b then pp_comma_a else empty,
1460 pprInstr (BF cond b lab)
1462 ptext SLIT("\tfb"), pprCond cond,
1463 if b then pp_comma_a else empty,
1468 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1470 pprInstr (CALL imm n _)
1471 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1474 Continue with SPARC-only printing bits and bobs:
1477 pprRI (RIReg r) = pprReg r
1478 pprRI (RIImm r) = pprImm r
1480 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1481 pprSizeRegReg name size reg1 reg2
1486 F -> ptext SLIT("s\t")
1487 DF -> ptext SLIT("d\t")),
1493 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1494 pprSizeRegRegReg name size reg1 reg2 reg3
1499 F -> ptext SLIT("s\t")
1500 DF -> ptext SLIT("d\t")),
1508 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1509 pprRegRIReg name b reg1 ri reg2
1513 if b then ptext SLIT("cc\t") else char '\t',
1521 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1522 pprRIReg name b ri reg1
1526 if b then ptext SLIT("cc\t") else char '\t',
1532 pp_ld_lbracket = ptext SLIT("\tld\t[")
1533 pp_rbracket_comma = text "],"
1534 pp_comma_lbracket = text ",["
1535 pp_comma_a = text ",a"
1537 #endif {-sparc_TARGET_ARCH-}