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 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)
402 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
403 ,IF_ARCH_sparc(SLIT("\t.text\n\t.align 4") {-word boundary-}
404 ,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
407 pprInstr (SEGMENT DataSegment)
409 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
410 ,IF_ARCH_sparc(SLIT("\t.data\n\t.align 8") {-<8 will break double constants -}
411 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
414 pprInstr (LABEL clab)
416 pp_lab = pprCLabel_asm clab
419 if not (externallyVisibleCLabel clab) then
423 IF_ARCH_alpha(SLIT("\t.globl\t")
424 ,IF_ARCH_i386(SLIT(".globl ")
425 ,IF_ARCH_sparc(SLIT("\t.global\t")
427 , pp_lab, char '\n'],
432 pprInstr (ASCII False{-no backslash conversion-} str)
433 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
435 pprInstr (ASCII True str)
436 = (<>) (text "\t.ascii \"") (asciify str 60)
438 asciify :: String -> Int -> SDoc
440 asciify [] _ = text "\\0\""
441 asciify s n | n <= 0 = (<>) (text "\"\n\t.ascii \"") (asciify s 60)
442 asciify ('\\':cs) n = (<>) (text "\\\\") (asciify cs (n-1))
443 asciify ('\"':cs) n = (<>) (text "\\\"") (asciify cs (n-1))
444 asciify (c:cs) n | isPrint c = (<>) (char c) (asciify cs (n-1))
445 asciify [c] _ = (<>) (text (charToC c)) (text ("\\0\"")){-"-}
446 asciify (c:(cs@(d:_))) n
447 | isDigit d = (<>) (text (charToC c)) (asciify cs 0)
448 | otherwise = (<>) (text (charToC c)) (asciify cs (n-1))
452 = vcat [(<>) (ptext pp_size) (pprImm x) | x <- xs]
455 #if alpha_TARGET_ARCH
456 B -> SLIT("\t.byte\t")
457 BU -> SLIT("\t.byte\t")
458 Q -> SLIT("\t.quad\t")
459 TF -> SLIT("\t.t_floating\t")
462 B -> SLIT("\t.byte\t")
463 L -> SLIT("\t.long\t")
464 F -> SLIT("\t.float\t")
465 DF -> SLIT("\t.double\t")
467 #if sparc_TARGET_ARCH
468 B -> SLIT("\t.byte\t")
469 BU -> SLIT("\t.byte\t")
470 W -> SLIT("\t.word\t")
471 DF -> SLIT("\t.double\t")
477 = vcat (concatMap (ppr_item s) xs)
479 #if alpha_TARGET_ARCH
480 ppr_item = error "ppr_item on Alpha"
482 This needs to be fixed.
483 B -> SLIT("\t.byte\t")
484 BU -> SLIT("\t.byte\t")
485 Q -> SLIT("\t.quad\t")
486 TF -> SLIT("\t.t_floating\t")
489 #if sparc_TARGET_ARCH
490 ppr_item = error "ppr_item on Sparc"
492 This needs to be fixed.
493 B -> SLIT("\t.byte\t")
494 BU -> SLIT("\t.byte\t")
495 W -> SLIT("\t.word\t")
496 DF -> SLIT("\t.double\t")
500 ppr_item B x = [text "\t.byte\t" <> pprImm x]
501 ppr_item L x = [text "\t.long\t" <> pprImm x]
502 ppr_item F (ImmDouble r)
503 = let bs = floatToBytes (fromRational r)
504 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
505 ppr_item DF (ImmDouble r)
506 = let bs = doubleToBytes (fromRational r)
507 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
509 floatToBytes :: Float -> [Int]
512 arr <- newFloatArray ((0::Int),3)
513 writeFloatArray arr 0 f
514 i0 <- readCharArray arr 0
515 i1 <- readCharArray arr 1
516 i2 <- readCharArray arr 2
517 i3 <- readCharArray arr 3
518 return (map ord [i0,i1,i2,i3])
521 doubleToBytes :: Double -> [Int]
524 arr <- newDoubleArray ((0::Int),7)
525 writeDoubleArray arr 0 d
526 i0 <- readCharArray arr 0
527 i1 <- readCharArray arr 1
528 i2 <- readCharArray arr 2
529 i3 <- readCharArray arr 3
530 i4 <- readCharArray arr 4
531 i5 <- readCharArray arr 5
532 i6 <- readCharArray arr 6
533 i7 <- readCharArray arr 7
534 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
539 -- fall through to rest of (machine-specific) pprInstr...
542 %************************************************************************
544 \subsubsection{@pprInstr@ for an Alpha}
546 %************************************************************************
549 #if alpha_TARGET_ARCH
551 pprInstr (LD size reg addr)
561 pprInstr (LDA reg addr)
563 ptext SLIT("\tlda\t"),
569 pprInstr (LDAH reg addr)
571 ptext SLIT("\tldah\t"),
577 pprInstr (LDGP reg addr)
579 ptext SLIT("\tldgp\t"),
585 pprInstr (LDI size reg imm)
595 pprInstr (ST size reg addr)
607 ptext SLIT("\tclr\t"),
611 pprInstr (ABS size ri reg)
621 pprInstr (NEG size ov ri reg)
625 if ov then ptext SLIT("v\t") else char '\t',
631 pprInstr (ADD size ov reg1 ri reg2)
635 if ov then ptext SLIT("v\t") else char '\t',
643 pprInstr (SADD size scale reg1 ri reg2)
645 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
656 pprInstr (SUB size ov reg1 ri reg2)
660 if ov then ptext SLIT("v\t") else char '\t',
668 pprInstr (SSUB size scale reg1 ri reg2)
670 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
681 pprInstr (MUL size ov reg1 ri reg2)
685 if ov then ptext SLIT("v\t") else char '\t',
693 pprInstr (DIV size uns reg1 ri reg2)
697 if uns then ptext SLIT("u\t") else char '\t',
705 pprInstr (REM size uns reg1 ri reg2)
709 if uns then ptext SLIT("u\t") else char '\t',
717 pprInstr (NOT ri reg)
726 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
727 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
728 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
729 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
730 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
731 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
733 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
734 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
735 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
737 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
738 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
740 pprInstr (NOP) = ptext SLIT("\tnop")
742 pprInstr (CMP cond reg1 ri reg2)
756 ptext SLIT("\tfclr\t"),
760 pprInstr (FABS reg1 reg2)
762 ptext SLIT("\tfabs\t"),
768 pprInstr (FNEG size reg1 reg2)
778 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
779 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
780 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
781 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
783 pprInstr (CVTxy size1 size2 reg1 reg2)
787 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
794 pprInstr (FCMP size cond reg1 reg2 reg3)
807 pprInstr (FMOV reg1 reg2)
809 ptext SLIT("\tfmov\t"),
815 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
817 pprInstr (BI NEVER reg lab) = empty
819 pprInstr (BI cond reg lab)
829 pprInstr (BF cond reg lab)
840 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
842 pprInstr (JMP reg addr hint)
844 ptext SLIT("\tjmp\t"),
853 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
855 pprInstr (JSR reg addr n)
857 ptext SLIT("\tjsr\t"),
863 pprInstr (FUNBEGIN clab)
865 if (externallyVisibleCLabel clab) then
866 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
869 ptext SLIT("\t.ent "),
878 pp_lab = pprCLabel_asm clab
880 -- NEVER use commas within those string literals, cpp will ruin your day
881 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
882 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
883 ptext SLIT("4240"), char ',',
884 ptext SLIT("$26"), char ',',
885 ptext SLIT("0\n\t.prologue 1") ]
887 pprInstr (FUNEND clab)
888 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
891 Continue with Alpha-only printing bits and bobs:
895 pprRI (RIReg r) = pprReg r
896 pprRI (RIImm r) = pprImm r
898 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
900 pprRegRIReg name reg1 ri reg2
912 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
914 pprSizeRegRegReg name size reg1 reg2 reg3
927 #endif {-alpha_TARGET_ARCH-}
930 %************************************************************************
932 \subsubsection{@pprInstr@ for an I386}
934 %************************************************************************
939 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
943 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
947 pprInstr (MOV size src dst)
948 = pprSizeOpOp SLIT("mov") size src dst
949 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
950 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
952 -- here we do some patching, since the physical registers are only set late
953 -- in the code generation.
954 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
956 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
957 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
959 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
960 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
962 = pprInstr (ADD size (OpImm displ) dst)
963 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
965 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
966 = pprSizeOp SLIT("dec") size dst
967 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
968 = pprSizeOp SLIT("inc") size dst
969 pprInstr (ADD size src dst)
970 = pprSizeOpOp SLIT("add") size src dst
971 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
972 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
973 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
975 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
976 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
977 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
978 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
979 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
981 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
982 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
983 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
985 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
986 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
987 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
988 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
989 pprInstr PUSHA = ptext SLIT("\tpushal")
990 pprInstr POPA = ptext SLIT("\tpopal")
992 pprInstr (NOP) = ptext SLIT("\tnop")
993 pprInstr (CLTD) = ptext SLIT("\tcltd")
995 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
997 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
999 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1000 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
1003 = hcat [ ptext SLIT("\tffree %st(0) ; call "), pprImm imm ]
1006 -- Simulating a flat register set on the x86 FP stack is tricky.
1007 -- you have to free %st(7) before pushing anything on the FP reg stack
1008 -- so as to preclude the possibility of a FP stack overflow exception.
1009 pprInstr g@(GMOV src dst)
1013 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1015 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1016 pprInstr g@(GLD sz addr dst)
1017 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1018 pprAddr addr, gsemi, gpop dst 1])
1020 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1021 pprInstr g@(GST sz src addr)
1022 = pprG g (hcat [gtab, gpush src 0, gsemi,
1023 text "fstp", pprSize sz, gsp, pprAddr addr])
1025 pprInstr g@(GFTOD src dst)
1027 pprInstr g@(GFTOI src dst)
1030 pprInstr g@(GDTOF src dst)
1032 pprInstr g@(GDTOI src dst)
1035 pprInstr g@(GITOF src dst)
1037 pprInstr g@(GITOD src dst)
1040 pprInstr g@(GCMP sz src1 src2)
1041 = pprG g (hcat [gtab, text "pushl %eax ; ",
1042 gpush src2 0, gsemi, gpush src1 1]
1044 hcat [gtab, text "fcompp ; fstsw %ax ; sahf ; popl %eax"])
1046 pprInstr g@(GABS sz src dst)
1048 pprInstr g@(GNEG sz src dst)
1050 pprInstr g@(GSQRT sz src dst)
1053 pprInstr g@(GADD sz src1 src2 dst)
1054 = pprG g (hcat [gtab, gpush src1 0,
1055 text " ; fadd ", greg src2 1, text ",%st(0)",
1057 pprInstr g@(GSUB sz src1 src2 dst)
1058 = pprG g (hcat [gtab, gpush src1 0,
1059 text " ; fsub ", greg src2 1, text ",%st(0)",
1061 pprInstr g@(GMUL sz src1 src2 dst)
1062 = pprG g (hcat [gtab, gpush src1 0,
1063 text " ; fmul ", greg src2 1, text ",%st(0)",
1065 pprInstr g@(GDIV sz src1 src2 dst)
1066 = pprG g (hcat [gtab, gpush src1 0,
1067 text " ; fdiv ", greg src2 1, text ",%st(0)",
1070 --------------------------
1072 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1074 = hcat [text "fstp ", greg reg offset]
1076 bogus = text "\tbogus"
1077 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1081 gregno (FixedReg i) = I# i
1082 gregno (MappedReg i) = I# i
1084 pprG :: Instr -> SDoc -> SDoc
1086 = (char '#' <> pprGInstr fake) $$ actual
1088 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst
1089 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1090 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1092 pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
1093 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
1095 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
1096 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1098 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
1099 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1101 pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
1102 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1103 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1104 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1106 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1107 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1108 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1109 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1112 Continue with I386-only printing bits and bobs:
1114 pprDollImm :: Imm -> SDoc
1116 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1118 pprOperand :: Size -> Operand -> SDoc
1119 pprOperand s (OpReg r) = pprReg s r
1120 pprOperand s (OpImm i) = pprDollImm i
1121 pprOperand s (OpAddr ea) = pprAddr ea
1123 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1124 pprSizeOp name size op1
1133 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1134 pprSizeOpOp name size op1 op2
1140 pprOperand size op1,
1145 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1146 pprSizeByteOpOp name size op1 op2
1157 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1158 pprSizeOpReg name size op1 reg
1164 pprOperand size op1,
1169 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1170 pprSizeRegReg name size reg1 reg2
1181 pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
1182 pprSizeSizeRegReg name size1 size2 reg1 reg2
1194 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1195 pprSizeRegRegReg name size reg1 reg2 reg3
1208 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1209 pprSizeAddr name size op
1218 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1219 pprSizeAddrReg name size op dst
1230 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
1231 pprSizeRegAddr name size src op
1242 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1243 pprOpOp name size op1 op2
1247 pprOperand size op1,
1252 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1253 pprSizeOpOpCoerce name size1 size2 op1 op2
1254 = hcat [ char '\t', ptext name, space,
1255 pprOperand size1 op1,
1257 pprOperand size2 op2
1260 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1261 pprCondInstr name cond arg
1262 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1264 #endif {-i386_TARGET_ARCH-}
1267 %************************************************************************
1269 \subsubsection{@pprInstr@ for a SPARC}
1271 %************************************************************************
1274 #if sparc_TARGET_ARCH
1276 -- a clumsy hack for now, to handle possible double alignment problems
1278 -- even clumsier, to allow for RegReg regs that show when doing indexed
1279 -- reads (bytearrays).
1281 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1283 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1284 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1285 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1288 pprInstr (LD DF addr reg) | maybeToBool off_addr
1302 off_addr = addrOffset addr 4
1303 addr2 = case off_addr of Just x -> x
1305 pprInstr (LD size addr reg)
1316 -- The same clumsy hack as above
1318 pprInstr (ST DF reg (AddrRegReg g1 g2))
1320 ptext SLIT("\tadd\t"),
1321 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1322 ptext SLIT("\tst\t"),
1323 pprReg reg, pp_comma_lbracket, pprReg g1,
1324 ptext SLIT("]\n\tst\t"),
1325 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1328 pprInstr (ST DF reg addr) | maybeToBool off_addr
1330 ptext SLIT("\tst\t"),
1331 pprReg reg, pp_comma_lbracket, pprAddr addr,
1333 ptext SLIT("]\n\tst\t"),
1334 pprReg (fPair reg), pp_comma_lbracket,
1335 pprAddr addr2, rbrack
1338 off_addr = addrOffset addr 4
1339 addr2 = case off_addr of Just x -> x
1341 -- no distinction is made between signed and unsigned bytes on stores for the
1342 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1343 -- so we call a special-purpose pprSize for ST..
1345 pprInstr (ST size reg addr)
1356 pprInstr (ADD x cc reg1 ri reg2)
1357 | not x && not cc && riZero ri
1358 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1360 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1362 pprInstr (SUB x cc reg1 ri reg2)
1363 | not x && cc && reg2 == g0
1364 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1365 | not x && not cc && riZero ri
1366 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1368 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1370 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1371 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1373 pprInstr (OR b reg1 ri reg2)
1374 | not b && reg1 == g0
1375 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1377 = pprRegRIReg SLIT("or") b reg1 ri reg2
1379 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1381 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1382 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1384 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1385 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1386 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1388 pprInstr (SETHI imm reg)
1390 ptext SLIT("\tsethi\t"),
1396 pprInstr NOP = ptext SLIT("\tnop")
1398 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1399 pprInstr (FABS DF reg1 reg2)
1400 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1401 (if (reg1 == reg2) then empty
1402 else (<>) (char '\n')
1403 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1405 pprInstr (FADD size reg1 reg2 reg3)
1406 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1407 pprInstr (FCMP e size reg1 reg2)
1408 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1409 pprInstr (FDIV size reg1 reg2 reg3)
1410 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1412 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1413 pprInstr (FMOV DF reg1 reg2)
1414 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1415 (if (reg1 == reg2) then empty
1416 else (<>) (char '\n')
1417 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1419 pprInstr (FMUL size reg1 reg2 reg3)
1420 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1422 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1423 pprInstr (FNEG DF reg1 reg2)
1424 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1425 (if (reg1 == reg2) then empty
1426 else (<>) (char '\n')
1427 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1429 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1430 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1431 pprInstr (FxTOy size1 size2 reg1 reg2)
1444 pprReg reg1, comma, pprReg reg2
1448 pprInstr (BI cond b lab)
1450 ptext SLIT("\tb"), pprCond cond,
1451 if b then pp_comma_a else empty,
1456 pprInstr (BF cond b lab)
1458 ptext SLIT("\tfb"), pprCond cond,
1459 if b then pp_comma_a else empty,
1464 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1466 pprInstr (CALL imm n _)
1467 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1470 Continue with SPARC-only printing bits and bobs:
1473 pprRI (RIReg r) = pprReg r
1474 pprRI (RIImm r) = pprImm r
1476 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1477 pprSizeRegReg name size reg1 reg2
1482 F -> ptext SLIT("s\t")
1483 DF -> ptext SLIT("d\t")),
1489 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1490 pprSizeRegRegReg name size reg1 reg2 reg3
1495 F -> ptext SLIT("s\t")
1496 DF -> ptext SLIT("d\t")),
1504 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1505 pprRegRIReg name b reg1 ri reg2
1509 if b then ptext SLIT("cc\t") else char '\t',
1517 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1518 pprRIReg name b ri reg1
1522 if b then ptext SLIT("cc\t") else char '\t',
1528 pp_ld_lbracket = ptext SLIT("\tld\t[")
1529 pp_rbracket_comma = text "],"
1530 pp_comma_lbracket = text ",["
1531 pp_comma_a = text ",a"
1533 #endif {-sparc_TARGET_ARCH-}