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 This needs to be fixed.
481 B -> SLIT("\t.byte\t")
482 BU -> SLIT("\t.byte\t")
483 Q -> SLIT("\t.quad\t")
484 TF -> SLIT("\t.t_floating\t")
487 ppr_item B x = [text "\t.byte\t" <> pprImm x]
488 ppr_item L x = [text "\t.long\t" <> pprImm x]
489 ppr_item F (ImmDouble r)
490 = let bs = floatToBytes (fromRational r)
491 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
492 ppr_item DF (ImmDouble r)
493 = let bs = doubleToBytes (fromRational r)
494 in map (\b -> text "\t.byte\t" <> pprImm (ImmInt b)) bs
496 floatToBytes :: Float -> [Int]
499 arr <- newFloatArray ((0::Int),3)
500 writeFloatArray arr 0 f
501 i0 <- readCharArray arr 0
502 i1 <- readCharArray arr 1
503 i2 <- readCharArray arr 2
504 i3 <- readCharArray arr 3
505 return (map ord [i0,i1,i2,i3])
508 doubleToBytes :: Double -> [Int]
511 arr <- newDoubleArray ((0::Int),7)
512 writeDoubleArray arr 0 d
513 i0 <- readCharArray arr 0
514 i1 <- readCharArray arr 1
515 i2 <- readCharArray arr 2
516 i3 <- readCharArray arr 3
517 i4 <- readCharArray arr 4
518 i5 <- readCharArray arr 5
519 i6 <- readCharArray arr 6
520 i7 <- readCharArray arr 7
521 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])
525 #if sparc_TARGET_ARCH
526 This needs to be fixed.
527 B -> SLIT("\t.byte\t")
528 BU -> SLIT("\t.byte\t")
529 W -> SLIT("\t.word\t")
530 DF -> SLIT("\t.double\t")
533 -- fall through to rest of (machine-specific) pprInstr...
536 %************************************************************************
538 \subsubsection{@pprInstr@ for an Alpha}
540 %************************************************************************
543 #if alpha_TARGET_ARCH
545 pprInstr (LD size reg addr)
555 pprInstr (LDA reg addr)
557 ptext SLIT("\tlda\t"),
563 pprInstr (LDAH reg addr)
565 ptext SLIT("\tldah\t"),
571 pprInstr (LDGP reg addr)
573 ptext SLIT("\tldgp\t"),
579 pprInstr (LDI size reg imm)
589 pprInstr (ST size reg addr)
601 ptext SLIT("\tclr\t"),
605 pprInstr (ABS size ri reg)
615 pprInstr (NEG size ov ri reg)
619 if ov then ptext SLIT("v\t") else char '\t',
625 pprInstr (ADD size ov reg1 ri reg2)
629 if ov then ptext SLIT("v\t") else char '\t',
637 pprInstr (SADD size scale reg1 ri reg2)
639 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
650 pprInstr (SUB size ov reg1 ri reg2)
654 if ov then ptext SLIT("v\t") else char '\t',
662 pprInstr (SSUB size scale reg1 ri reg2)
664 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
675 pprInstr (MUL size ov reg1 ri reg2)
679 if ov then ptext SLIT("v\t") else char '\t',
687 pprInstr (DIV size uns reg1 ri reg2)
691 if uns then ptext SLIT("u\t") else char '\t',
699 pprInstr (REM size uns reg1 ri reg2)
703 if uns then ptext SLIT("u\t") else char '\t',
711 pprInstr (NOT ri reg)
720 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
721 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
722 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
723 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
724 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
725 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
727 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
728 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
729 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
731 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
732 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
734 pprInstr (NOP) = ptext SLIT("\tnop")
736 pprInstr (CMP cond reg1 ri reg2)
750 ptext SLIT("\tfclr\t"),
754 pprInstr (FABS reg1 reg2)
756 ptext SLIT("\tfabs\t"),
762 pprInstr (FNEG size reg1 reg2)
772 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
773 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
774 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
775 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
777 pprInstr (CVTxy size1 size2 reg1 reg2)
781 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
788 pprInstr (FCMP size cond reg1 reg2 reg3)
801 pprInstr (FMOV reg1 reg2)
803 ptext SLIT("\tfmov\t"),
809 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
811 pprInstr (BI NEVER reg lab) = empty
813 pprInstr (BI cond reg lab)
823 pprInstr (BF cond reg lab)
834 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
836 pprInstr (JMP reg addr hint)
838 ptext SLIT("\tjmp\t"),
847 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
849 pprInstr (JSR reg addr n)
851 ptext SLIT("\tjsr\t"),
857 pprInstr (FUNBEGIN clab)
859 if (externallyVisibleCLabel clab) then
860 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
863 ptext SLIT("\t.ent "),
872 pp_lab = pprCLabel_asm clab
874 -- NEVER use commas within those string literals, cpp will ruin your day
875 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
876 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
877 ptext SLIT("4240"), char ',',
878 ptext SLIT("$26"), char ',',
879 ptext SLIT("0\n\t.prologue 1") ]
881 pprInstr (FUNEND clab)
882 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
885 Continue with Alpha-only printing bits and bobs:
889 pprRI (RIReg r) = pprReg r
890 pprRI (RIImm r) = pprImm r
892 pprRegRIReg :: FAST_STRING -> Reg -> RI -> Reg -> SDoc
894 pprRegRIReg name reg1 ri reg2
906 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
908 pprSizeRegRegReg name size reg1 reg2 reg3
921 #endif {-alpha_TARGET_ARCH-}
924 %************************************************************************
926 \subsubsection{@pprInstr@ for an I386}
928 %************************************************************************
933 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
937 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
941 pprInstr (MOV size src dst)
942 = pprSizeOpOp SLIT("mov") size src dst
943 pprInstr (MOVZX size src dst) = pprSizeOpOpCoerce SLIT("movzx") L size src dst
944 pprInstr (MOVSX size src dst) = pprSizeOpOpCoerce SLIT("movxs") L size src dst
946 -- here we do some patching, since the physical registers are only set late
947 -- in the code generation.
948 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
950 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
951 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
953 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
954 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
956 = pprInstr (ADD size (OpImm displ) dst)
957 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
959 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
960 = pprSizeOp SLIT("dec") size dst
961 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
962 = pprSizeOp SLIT("inc") size dst
963 pprInstr (ADD size src dst)
964 = pprSizeOpOp SLIT("add") size src dst
965 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
966 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
967 pprInstr (IDIV size op) = pprSizeOp SLIT("idiv") size op
969 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
970 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
971 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
972 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
973 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
975 pprInstr (SHL size imm dst) = pprSizeByteOpOp SLIT("shl") size imm dst
976 pprInstr (SAR size imm dst) = pprSizeByteOpOp SLIT("sar") size imm dst
977 pprInstr (SHR size imm dst) = pprSizeByteOpOp SLIT("shr") size imm dst
979 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
980 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
981 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
982 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
983 pprInstr PUSHA = ptext SLIT("\tpushal")
984 pprInstr POPA = ptext SLIT("\tpopal")
986 pprInstr (NOP) = ptext SLIT("\tnop")
987 pprInstr (CLTD) = ptext SLIT("\tcltd")
989 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
991 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
993 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
994 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
997 = hcat [ ptext SLIT("\tffree %st(0) ; call "), pprImm imm ]
1000 -- Simulating a flat register set on the x86 FP stack is tricky.
1001 -- you have to free %st(7) before pushing anything on the FP reg stack
1002 -- so as to preclude the possibility of a FP stack overflow exception.
1003 -- ToDo: make gpop into a single instruction, FST
1004 pprInstr g@(GMOV src dst)
1005 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1007 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FXCH (dst+1) ; FINCSTP
1008 pprInstr g@(GLD sz addr dst)
1009 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1010 pprAddr addr, gsemi, gpop dst 1])
1012 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1013 pprInstr g@(GST sz src addr)
1014 = pprG g (hcat [gtab, gpush src 0, gsemi,
1015 text "fstp", pprSize sz, gsp, pprAddr addr])
1017 pprInstr g@(GFTOD src dst)
1019 pprInstr g@(GFTOI src dst)
1022 pprInstr g@(GDTOF src dst)
1024 pprInstr g@(GDTOI src dst)
1027 pprInstr g@(GITOF src dst)
1029 pprInstr g@(GITOD src dst)
1032 pprInstr g@(GCMP sz src1 src2)
1033 = pprG g (hcat [gtab, text "pushl %eax ; ",
1034 gpush src2 0, gsemi, gpush src1 1]
1036 hcat [gtab, text "fcompp ; fstsw %ax ; sahf ; popl %eax"])
1038 pprInstr g@(GABS sz src dst)
1040 pprInstr g@(GNEG sz src dst)
1042 pprInstr g@(GSQRT sz src dst)
1045 pprInstr g@(GADD sz src1 src2 dst)
1046 = pprG g (hcat [gtab, gpush src1 0,
1047 text " ; fadd ", greg src2 1, text ",%st(0)",
1049 pprInstr g@(GSUB sz src1 src2 dst)
1050 = pprG g (hcat [gtab, gpush src1 0,
1051 text " ; fsub ", greg src2 1, text ",%st(0)",
1053 pprInstr g@(GMUL sz src1 src2 dst)
1054 = pprG g (hcat [gtab, gpush src1 0,
1055 text " ; fmul ", greg src2 1, text ",%st(0)",
1057 pprInstr g@(GDIV sz src1 src2 dst)
1058 = pprG g (hcat [gtab, gpush src1 0,
1059 text " ; fdiv ", greg src2 1, text ",%st(0)",
1062 --------------------------
1064 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1066 = hcat [text "fxch ", greg reg offset, gsemi, text "fincstp"]
1068 bogus = text "\tbogus"
1069 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1073 gregno (FixedReg i) = I# i
1074 gregno (MappedReg i) = I# i
1076 pprG :: Instr -> SDoc -> SDoc
1078 = (char '#' <> pprGInstr fake) $$ actual
1080 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst
1081 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1082 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1084 pprGInstr (GFTOD src dst) = pprSizeSizeRegReg SLIT("gftod") F DF src dst
1085 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
1087 pprGInstr (GDTOF src dst) = pprSizeSizeRegReg SLIT("gdtof") DF F src dst
1088 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1090 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
1091 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1093 pprGInstr (GCMP sz src dst) = pprSizeRegReg SLIT("gcmp") sz src dst
1094 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1095 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1096 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1098 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1099 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1100 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1101 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1104 Continue with I386-only printing bits and bobs:
1106 pprDollImm :: Imm -> SDoc
1108 pprDollImm i = hcat [ ptext SLIT("$"), pprImm i]
1110 pprOperand :: Size -> Operand -> SDoc
1111 pprOperand s (OpReg r) = pprReg s r
1112 pprOperand s (OpImm i) = pprDollImm i
1113 pprOperand s (OpAddr ea) = pprAddr ea
1115 pprSizeOp :: FAST_STRING -> Size -> Operand -> SDoc
1116 pprSizeOp name size op1
1125 pprSizeOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1126 pprSizeOpOp name size op1 op2
1132 pprOperand size op1,
1137 pprSizeByteOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1138 pprSizeByteOpOp name size op1 op2
1149 pprSizeOpReg :: FAST_STRING -> Size -> Operand -> Reg -> SDoc
1150 pprSizeOpReg name size op1 reg
1156 pprOperand size op1,
1161 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1162 pprSizeRegReg name size reg1 reg2
1173 pprSizeSizeRegReg :: FAST_STRING -> Size -> Size -> Reg -> Reg -> SDoc
1174 pprSizeSizeRegReg name size1 size2 reg1 reg2
1186 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1187 pprSizeRegRegReg name size reg1 reg2 reg3
1200 pprSizeAddr :: FAST_STRING -> Size -> MachRegsAddr -> SDoc
1201 pprSizeAddr name size op
1210 pprSizeAddrReg :: FAST_STRING -> Size -> MachRegsAddr -> Reg -> SDoc
1211 pprSizeAddrReg name size op dst
1222 pprSizeRegAddr :: FAST_STRING -> Size -> Reg -> MachRegsAddr -> SDoc
1223 pprSizeRegAddr name size src op
1234 pprOpOp :: FAST_STRING -> Size -> Operand -> Operand -> SDoc
1235 pprOpOp name size op1 op2
1239 pprOperand size op1,
1244 pprSizeOpOpCoerce :: FAST_STRING -> Size -> Size -> Operand -> Operand -> SDoc
1245 pprSizeOpOpCoerce name size1 size2 op1 op2
1246 = hcat [ char '\t', ptext name, space,
1247 pprOperand size1 op1,
1249 pprOperand size2 op2
1252 pprCondInstr :: FAST_STRING -> Cond -> SDoc -> SDoc
1253 pprCondInstr name cond arg
1254 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1256 #endif {-i386_TARGET_ARCH-}
1259 %************************************************************************
1261 \subsubsection{@pprInstr@ for a SPARC}
1263 %************************************************************************
1266 #if sparc_TARGET_ARCH
1268 -- a clumsy hack for now, to handle possible double alignment problems
1270 -- even clumsier, to allow for RegReg regs that show when doing indexed
1271 -- reads (bytearrays).
1273 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1275 ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1276 pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg, char '\n',
1277 pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)
1280 pprInstr (LD DF addr reg) | maybeToBool off_addr
1294 off_addr = addrOffset addr 4
1295 addr2 = case off_addr of Just x -> x
1297 pprInstr (LD size addr reg)
1308 -- The same clumsy hack as above
1310 pprInstr (ST DF reg (AddrRegReg g1 g2))
1312 ptext SLIT("\tadd\t"),
1313 pprReg g1,comma,pprReg g2,comma,pprReg g1, char '\n',
1314 ptext SLIT("\tst\t"),
1315 pprReg reg, pp_comma_lbracket, pprReg g1,
1316 ptext SLIT("]\n\tst\t"),
1317 pprReg (fPair reg), pp_comma_lbracket, pprReg g1, ptext SLIT("+4]")
1320 pprInstr (ST DF reg addr) | maybeToBool off_addr
1322 ptext SLIT("\tst\t"),
1323 pprReg reg, pp_comma_lbracket, pprAddr addr,
1325 ptext SLIT("]\n\tst\t"),
1326 pprReg (fPair reg), pp_comma_lbracket,
1327 pprAddr addr2, rbrack
1330 off_addr = addrOffset addr 4
1331 addr2 = case off_addr of Just x -> x
1333 -- no distinction is made between signed and unsigned bytes on stores for the
1334 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1335 -- so we call a special-purpose pprSize for ST..
1337 pprInstr (ST size reg addr)
1348 pprInstr (ADD x cc reg1 ri reg2)
1349 | not x && not cc && riZero ri
1350 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1352 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1354 pprInstr (SUB x cc reg1 ri reg2)
1355 | not x && cc && reg2 == g0
1356 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1357 | not x && not cc && riZero ri
1358 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1360 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1362 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1363 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1365 pprInstr (OR b reg1 ri reg2)
1366 | not b && reg1 == g0
1367 = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1369 = pprRegRIReg SLIT("or") b reg1 ri reg2
1371 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1373 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1374 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1376 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1377 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1378 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1380 pprInstr (SETHI imm reg)
1382 ptext SLIT("\tsethi\t"),
1388 pprInstr NOP = ptext SLIT("\tnop")
1390 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1391 pprInstr (FABS DF reg1 reg2)
1392 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1393 (if (reg1 == reg2) then empty
1394 else (<>) (char '\n')
1395 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1397 pprInstr (FADD size reg1 reg2 reg3)
1398 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1399 pprInstr (FCMP e size reg1 reg2)
1400 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1401 pprInstr (FDIV size reg1 reg2 reg3)
1402 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1404 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1405 pprInstr (FMOV DF reg1 reg2)
1406 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1407 (if (reg1 == reg2) then empty
1408 else (<>) (char '\n')
1409 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1411 pprInstr (FMUL size reg1 reg2 reg3)
1412 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1414 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1415 pprInstr (FNEG DF reg1 reg2)
1416 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1417 (if (reg1 == reg2) then empty
1418 else (<>) (char '\n')
1419 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1421 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1422 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1423 pprInstr (FxTOy size1 size2 reg1 reg2)
1436 pprReg reg1, comma, pprReg reg2
1440 pprInstr (BI cond b lab)
1442 ptext SLIT("\tb"), pprCond cond,
1443 if b then pp_comma_a else empty,
1448 pprInstr (BF cond b lab)
1450 ptext SLIT("\tfb"), pprCond cond,
1451 if b then pp_comma_a else empty,
1456 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1458 pprInstr (CALL imm n _)
1459 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1462 Continue with SPARC-only printing bits and bobs:
1465 pprRI (RIReg r) = pprReg r
1466 pprRI (RIImm r) = pprImm r
1468 pprSizeRegReg :: FAST_STRING -> Size -> Reg -> Reg -> SDoc
1469 pprSizeRegReg name size reg1 reg2
1474 F -> ptext SLIT("s\t")
1475 DF -> ptext SLIT("d\t")),
1481 pprSizeRegRegReg :: FAST_STRING -> Size -> Reg -> Reg -> Reg -> SDoc
1482 pprSizeRegRegReg name size reg1 reg2 reg3
1487 F -> ptext SLIT("s\t")
1488 DF -> ptext SLIT("d\t")),
1496 pprRegRIReg :: FAST_STRING -> Bool -> Reg -> RI -> Reg -> SDoc
1497 pprRegRIReg name b reg1 ri reg2
1501 if b then ptext SLIT("cc\t") else char '\t',
1509 pprRIReg :: FAST_STRING -> Bool -> RI -> Reg -> SDoc
1510 pprRIReg name b ri reg1
1514 if b then ptext SLIT("cc\t") else char '\t',
1520 pp_ld_lbracket = ptext SLIT("\tld\t[")
1521 pp_rbracket_comma = text "],"
1522 pp_comma_lbracket = text ",["
1523 pp_comma_a = text ",a"
1525 #endif {-sparc_TARGET_ARCH-}