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 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1004 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)"),
1005 hcat [ ptext SLIT("\tcall "), pprImm imm ]
1009 -- Simulating a flat register set on the x86 FP stack is tricky.
1010 -- you have to free %st(7) before pushing anything on the FP reg stack
1011 -- so as to preclude the possibility of a FP stack overflow exception.
1012 pprInstr g@(GMOV src dst)
1016 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1018 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1019 pprInstr g@(GLD sz addr dst)
1020 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1021 pprAddr addr, gsemi, gpop dst 1])
1023 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1024 pprInstr g@(GST sz src addr)
1025 = pprG g (hcat [gtab, gpush src 0, gsemi,
1026 text "fstp", pprSize sz, gsp, pprAddr addr])
1028 pprInstr g@(GFTOD src dst)
1030 pprInstr g@(GFTOI src dst)
1033 pprInstr g@(GDTOF src dst)
1035 pprInstr g@(GDTOI src dst)
1038 pprInstr g@(GITOF src dst)
1040 pprInstr g@(GITOD src dst)
1043 pprInstr g@(GCMP sz src1 src2)
1044 = pprG g (hcat [gtab, text "pushl %eax ; ",
1045 gpush src2 0, gsemi, gpush src1 1]
1047 hcat [gtab, text "fcompp ; fstsw %ax ; sahf ; popl %eax"])
1049 pprInstr g@(GABS sz src dst)
1051 pprInstr g@(GNEG sz src dst)
1053 pprInstr g@(GSQRT sz src dst)
1056 pprInstr g@(GADD sz src1 src2 dst)
1057 = pprG g (hcat [gtab, gpush src1 0,
1058 text " ; fadd ", greg src2 1, text ",%st(0)",
1060 pprInstr g@(GSUB sz src1 src2 dst)
1061 = pprG g (hcat [gtab, gpush src1 0,
1062 text " ; fsub ", greg src2 1, text ",%st(0)",
1064 pprInstr g@(GMUL sz src1 src2 dst)
1065 = pprG g (hcat [gtab, gpush src1 0,
1066 text " ; fmul ", greg src2 1, text ",%st(0)",
1068 pprInstr g@(GDIV sz src1 src2 dst)
1069 = pprG g (hcat [gtab, gpush src1 0,
1070 text " ; fdiv ", greg src2 1, text ",%st(0)",
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
1087 pprG :: Instr -> SDoc -> SDoc
1089 = (char '#' <> pprGInstr fake) $$ actual
1091 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst
1092 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1093 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1095 pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
1096 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
1098 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
1099 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1101 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
1102 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1104 pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
1105 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1106 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1107 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1109 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1110 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1111 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1112 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1115 Continue with I386-only printing bits and bobs:
1117 pprDollImm :: Imm -> SDoc
1119 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1121 pprOperand :: Size -> Operand -> SDoc
1122 pprOperand s (OpReg r) = pprReg s r
1123 pprOperand s (OpImm i) = pprDollImm i
1124 pprOperand s (OpAddr ea) = pprAddr ea
1126 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1127 pprSizeOp name size op1
1136 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1137 pprSizeOpOp name size op1 op2
1143 pprOperand size op1,
1148 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1149 pprSizeByteOpOp name size op1 op2
1160 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1161 pprSizeOpReg name size op1 reg
1167 pprOperand size op1,
1172 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1173 pprSizeRegReg name size reg1 reg2
1184 pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
1185 pprSizeSizeRegReg name size1 size2 reg1 reg2
1197 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1198 pprSizeRegRegReg name size reg1 reg2 reg3
1211 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1212 pprSizeAddr name size op
1221 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1222 pprSizeAddrReg name size op dst
1233 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
1234 pprSizeRegAddr name size src op
1245 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1246 pprOpOp name size op1 op2
1250 pprOperand size op1,
1255 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1256 pprSizeOpOpCoerce name size1 size2 op1 op2
1257 = hcat [ char '\t', ptext name, space,
1258 pprOperand size1 op1,
1260 pprOperand size2 op2
1263 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1264 pprCondInstr name cond arg
1265 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1267 #endif {-i386_TARGET_ARCH-}
1270 %************************************************************************
1272 \subsubsection{@pprInstr@ for a SPARC}
1274 %************************************************************************
1277 #if sparc_TARGET_ARCH
1279 -- a clumsy hack for now, to handle possible double alignment problems
1281 -- even clumsier, to allow for RegReg regs that show when doing indexed
1282 -- reads (bytearrays).
1284 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1286 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1287 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1288 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1291 pprInstr (LD DF addr reg) | maybeToBool off_addr
1305 off_addr = addrOffset addr 4
1306 addr2 = case off_addr of Just x -> x
1308 pprInstr (LD size addr reg)
1319 -- The same clumsy hack as above
1321 pprInstr (ST DF reg (AddrRegReg g1 g2))
1323 ptext SLIT("\tadd\t"),
1324 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1325 ptext SLIT("\tst\t"),
1326 pprReg reg, pp_comma_lbracket, pprReg g1,
1327 ptext SLIT("]\n\tst\t"),
1328 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1331 pprInstr (ST DF reg addr) | maybeToBool off_addr
1333 ptext SLIT("\tst\t"),
1334 pprReg reg, pp_comma_lbracket, pprAddr addr,
1336 ptext SLIT("]\n\tst\t"),
1337 pprReg (fPair reg), pp_comma_lbracket,
1338 pprAddr addr2, rbrack
1341 off_addr = addrOffset addr 4
1342 addr2 = case off_addr of Just x -> x
1344 -- no distinction is made between signed and unsigned bytes on stores for the
1345 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1346 -- so we call a special-purpose pprSize for ST..
1348 pprInstr (ST size reg addr)
1359 pprInstr (ADD x cc reg1 ri reg2)
1360 | not x && not cc && riZero ri
1361 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1363 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1365 pprInstr (SUB x cc reg1 ri reg2)
1366 | not x && cc && reg2 == g0
1367 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1368 | not x && not cc && riZero ri
1369 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1371 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1373 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1374 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1376 pprInstr (OR b reg1 ri reg2)
1377 | not b && reg1 == g0
1378 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1380 = pprRegRIReg SLIT("or") b reg1 ri reg2
1382 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1384 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1385 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1387 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1388 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1389 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1391 pprInstr (SETHI imm reg)
1393 ptext SLIT("\tsethi\t"),
1399 pprInstr NOP = ptext SLIT("\tnop")
1401 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1402 pprInstr (FABS DF reg1 reg2)
1403 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1404 (if (reg1 == reg2) then empty
1405 else (<>) (char '\n')
1406 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1408 pprInstr (FADD size reg1 reg2 reg3)
1409 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1410 pprInstr (FCMP e size reg1 reg2)
1411 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1412 pprInstr (FDIV size reg1 reg2 reg3)
1413 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1415 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1416 pprInstr (FMOV DF reg1 reg2)
1417 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1418 (if (reg1 == reg2) then empty
1419 else (<>) (char '\n')
1420 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1422 pprInstr (FMUL size reg1 reg2 reg3)
1423 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1425 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1426 pprInstr (FNEG DF reg1 reg2)
1427 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1428 (if (reg1 == reg2) then empty
1429 else (<>) (char '\n')
1430 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1432 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1433 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1434 pprInstr (FxTOy size1 size2 reg1 reg2)
1447 pprReg reg1, comma, pprReg reg2
1451 pprInstr (BI cond b lab)
1453 ptext SLIT("\tb"), pprCond cond,
1454 if b then pp_comma_a else empty,
1459 pprInstr (BF cond b lab)
1461 ptext SLIT("\tfb"), pprCond cond,
1462 if b then pp_comma_a else empty,
1467 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1469 pprInstr (CALL imm n _)
1470 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1473 Continue with SPARC-only printing bits and bobs:
1476 pprRI (RIReg r) = pprReg r
1477 pprRI (RIImm r) = pprImm r
1479 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1480 pprSizeRegReg name size reg1 reg2
1485 F -> ptext SLIT("s\t")
1486 DF -> ptext SLIT("d\t")),
1492 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1493 pprSizeRegRegReg name size reg1 reg2 reg3
1498 F -> ptext SLIT("s\t")
1499 DF -> ptext SLIT("d\t")),
1507 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1508 pprRegRIReg name b reg1 ri reg2
1512 if b then ptext SLIT("cc\t") else char '\t',
1520 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1521 pprRIReg name b ri reg1
1525 if b then ptext SLIT("cc\t") else char '\t',
1531 pp_ld_lbracket = ptext SLIT("\tld\t[")
1532 pp_rbracket_comma = text "],"
1533 pp_comma_lbracket = text ",["
1534 pp_comma_a = text ",a"
1536 #endif {-sparc_TARGET_ARCH-}