2 % (c) The AQUA Project, Glasgow University, 1996-1998
4 \section[PprMach]{Pretty-printing assembly language}
6 We start with the @pprXXX@s with some cross-platform commonality
7 (e.g., @pprReg@); we conclude with the no-commonality monster,
11 #include "nativeGen/NCG.h"
13 module PprMach ( pprInstr, pprSize, pprUserReg IF_OS_darwin(COMMA pprDyldSymbolStub, ) ) where
15 #include "HsVersions.h"
17 import MachRegs -- may differ per-platform
20 import CLabel ( pprCLabel, externallyVisibleCLabel, labelDynamic )
21 import Stix ( CodeSegment(..) )
22 import Panic ( panic )
25 import qualified Outputable
27 #if __GLASGOW_HASKELL__ >= 504
29 import Data.Word ( Word8, Word16 )
32 import Word ( Word16 )
37 import Char ( chr, ord )
38 import Maybe ( isJust )
40 asmSDoc d = Outputable.withPprStyleDoc (
41 Outputable.mkCodeStyle Outputable.AsmStyle) d
42 pprCLabel_asm l = asmSDoc (pprCLabel l)
45 %************************************************************************
47 \subsection{@pprReg@: print a @Reg@}
49 %************************************************************************
51 For x86, the way we print a register name depends
52 on which bit of it we care about. Yurgh.
54 pprUserReg :: Reg -> Doc
55 pprUserReg = pprReg IF_ARCH_i386(L,)
57 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc
59 pprReg IF_ARCH_i386(s,) r
61 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) i
62 VirtualRegI u -> text "%vI_" <> asmSDoc (pprVRegUnique u)
63 VirtualRegF u -> text "%vF_" <> asmSDoc (pprVRegUnique u)
66 ppr_reg_no :: Int -> Doc
69 0 -> SLIT("$0"); 1 -> SLIT("$1");
70 2 -> SLIT("$2"); 3 -> SLIT("$3");
71 4 -> SLIT("$4"); 5 -> SLIT("$5");
72 6 -> SLIT("$6"); 7 -> SLIT("$7");
73 8 -> SLIT("$8"); 9 -> SLIT("$9");
74 10 -> SLIT("$10"); 11 -> SLIT("$11");
75 12 -> SLIT("$12"); 13 -> SLIT("$13");
76 14 -> SLIT("$14"); 15 -> SLIT("$15");
77 16 -> SLIT("$16"); 17 -> SLIT("$17");
78 18 -> SLIT("$18"); 19 -> SLIT("$19");
79 20 -> SLIT("$20"); 21 -> SLIT("$21");
80 22 -> SLIT("$22"); 23 -> SLIT("$23");
81 24 -> SLIT("$24"); 25 -> SLIT("$25");
82 26 -> SLIT("$26"); 27 -> SLIT("$27");
83 28 -> SLIT("$28"); 29 -> SLIT("$29");
84 30 -> SLIT("$30"); 31 -> SLIT("$31");
85 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
86 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
87 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
88 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
89 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
90 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
91 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
92 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
93 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
94 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
95 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
96 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
97 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
98 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
99 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
100 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
101 _ -> SLIT("very naughty alpha register")
105 ppr_reg_no :: Size -> Int -> Doc
106 ppr_reg_no B = ppr_reg_byte
107 ppr_reg_no Bu = ppr_reg_byte
108 ppr_reg_no W = ppr_reg_word
109 ppr_reg_no Wu = ppr_reg_word
110 ppr_reg_no _ = ppr_reg_long
112 ppr_reg_byte i = ptext
114 0 -> SLIT("%al"); 1 -> SLIT("%bl");
115 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
116 _ -> SLIT("very naughty I386 byte register")
119 ppr_reg_word i = ptext
121 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
122 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
123 4 -> SLIT("%si"); 5 -> SLIT("%di");
124 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
125 _ -> SLIT("very naughty I386 word register")
128 ppr_reg_long i = ptext
130 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
131 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
132 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
133 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
134 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
135 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
136 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
137 _ -> SLIT("very naughty I386 register")
140 #if sparc_TARGET_ARCH
141 ppr_reg_no :: Int -> Doc
144 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
145 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
146 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
147 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
148 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
149 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
150 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
151 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
152 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
153 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
154 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
155 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
156 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
157 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
158 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
159 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
160 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
161 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
162 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
163 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
164 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
165 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
166 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
167 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
168 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
169 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
170 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
171 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
172 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
173 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
174 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
175 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
176 _ -> SLIT("very naughty sparc register")
179 #if powerpc_TARGET_ARCH
180 ppr_reg_no :: Int -> Doc
183 0 -> SLIT("r0"); 1 -> SLIT("r1");
184 2 -> SLIT("r2"); 3 -> SLIT("r3");
185 4 -> SLIT("r4"); 5 -> SLIT("r5");
186 6 -> SLIT("r6"); 7 -> SLIT("r7");
187 8 -> SLIT("r8"); 9 -> SLIT("r9");
188 10 -> SLIT("r10"); 11 -> SLIT("r11");
189 12 -> SLIT("r12"); 13 -> SLIT("r13");
190 14 -> SLIT("r14"); 15 -> SLIT("r15");
191 16 -> SLIT("r16"); 17 -> SLIT("r17");
192 18 -> SLIT("r18"); 19 -> SLIT("r19");
193 20 -> SLIT("r20"); 21 -> SLIT("r21");
194 22 -> SLIT("r22"); 23 -> SLIT("r23");
195 24 -> SLIT("r24"); 25 -> SLIT("r25");
196 26 -> SLIT("r26"); 27 -> SLIT("r27");
197 28 -> SLIT("r28"); 29 -> SLIT("r29");
198 30 -> SLIT("r30"); 31 -> SLIT("r31");
199 32 -> SLIT("f0"); 33 -> SLIT("f1");
200 34 -> SLIT("f2"); 35 -> SLIT("f3");
201 36 -> SLIT("f4"); 37 -> SLIT("f5");
202 38 -> SLIT("f6"); 39 -> SLIT("f7");
203 40 -> SLIT("f8"); 41 -> SLIT("f9");
204 42 -> SLIT("f10"); 43 -> SLIT("f11");
205 44 -> SLIT("f12"); 45 -> SLIT("f13");
206 46 -> SLIT("f14"); 47 -> SLIT("f15");
207 48 -> SLIT("f16"); 49 -> SLIT("f17");
208 50 -> SLIT("f18"); 51 -> SLIT("f19");
209 52 -> SLIT("f20"); 53 -> SLIT("f21");
210 54 -> SLIT("f22"); 55 -> SLIT("f23");
211 56 -> SLIT("f24"); 57 -> SLIT("f25");
212 58 -> SLIT("f26"); 59 -> SLIT("f27");
213 60 -> SLIT("f28"); 61 -> SLIT("f29");
214 62 -> SLIT("f30"); 63 -> SLIT("f31");
215 _ -> SLIT("very naughty powerpc register")
220 %************************************************************************
222 \subsection{@pprSize@: print a @Size@}
224 %************************************************************************
227 pprSize :: Size -> Doc
229 pprSize x = ptext (case x of
230 #if alpha_TARGET_ARCH
233 -- W -> SLIT("w") UNUSED
234 -- Wu -> SLIT("wu") UNUSED
237 -- FF -> SLIT("f") UNUSED
238 -- DF -> SLIT("d") UNUSED
239 -- GF -> SLIT("g") UNUSED
240 -- SF -> SLIT("s") UNUSED
254 #if sparc_TARGET_ARCH
263 pprStSize :: Size -> Doc
264 pprStSize x = ptext (case x of
273 #if powerpc_TARGET_ARCH
285 %************************************************************************
287 \subsection{@pprCond@: print a @Cond@}
289 %************************************************************************
292 pprCond :: Cond -> Doc
294 pprCond c = ptext (case c of {
295 #if alpha_TARGET_ARCH
306 GEU -> SLIT("ae"); LU -> SLIT("b");
307 EQQ -> SLIT("e"); GTT -> SLIT("g");
308 GE -> SLIT("ge"); GU -> SLIT("a");
309 LTT -> SLIT("l"); LE -> SLIT("le");
310 LEU -> SLIT("be"); NE -> SLIT("ne");
311 NEG -> SLIT("s"); POS -> SLIT("ns");
312 CARRY -> SLIT("c"); OFLO -> SLIT("o");
313 ALWAYS -> SLIT("mp") -- hack
315 #if sparc_TARGET_ARCH
316 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
317 GEU -> SLIT("geu"); LU -> SLIT("lu");
318 EQQ -> SLIT("e"); GTT -> SLIT("g");
319 GE -> SLIT("ge"); GU -> SLIT("gu");
320 LTT -> SLIT("l"); LE -> SLIT("le");
321 LEU -> SLIT("leu"); NE -> SLIT("ne");
322 NEG -> SLIT("neg"); POS -> SLIT("pos");
323 VC -> SLIT("vc"); VS -> SLIT("vs")
325 #if powerpc_TARGET_ARCH
327 EQQ -> SLIT("eq"); NE -> SLIT("ne");
328 LTT -> SLIT("lt"); GE -> SLIT("ge");
329 GTT -> SLIT("gt"); LE -> SLIT("le");
330 LU -> SLIT("lt"); GEU -> SLIT("ge");
331 GU -> SLIT("gt"); LEU -> SLIT("le");
336 %************************************************************************
338 \subsection{@pprImm@: print an @Imm@}
340 %************************************************************************
345 pprImm (ImmInt i) = int i
346 pprImm (ImmInteger i) = integer i
347 pprImm (ImmCLbl l) = (if labelDynamic l then text "__imp_" else empty)
349 pprImm (ImmIndex l i) = (if labelDynamic l then text "__imp_" else empty)
350 <> pprCLabel_asm l <> char '+' <> int i
351 pprImm (ImmLit s) = s
353 pprImm (ImmLab dll s) = (if underscorePrefix then char '_' else empty)
354 <> (if dll then text "_imp__" else empty)
357 #if sparc_TARGET_ARCH
359 = hcat [ pp_lo, pprImm i, rparen ]
364 = hcat [ pp_hi, pprImm i, rparen ]
368 #if powerpc_TARGET_ARCH
370 = hcat [ pp_lo, pprImm i, rparen ]
375 = hcat [ pp_hi, pprImm i, rparen ]
380 = hcat [ pp_ha, pprImm i, rparen ]
386 %************************************************************************
388 \subsection{@pprAddr@: print an @Addr@}
390 %************************************************************************
393 pprAddr :: MachRegsAddr -> Doc
395 #if alpha_TARGET_ARCH
396 pprAddr (AddrReg r) = parens (pprReg r)
397 pprAddr (AddrImm i) = pprImm i
398 pprAddr (AddrRegImm r1 i)
399 = (<>) (pprImm i) (parens (pprReg r1))
405 pprAddr (ImmAddr imm off)
406 = let pp_imm = pprImm imm
410 else if (off < 0) then
413 pp_imm <> char '+' <> int off
415 pprAddr (AddrBaseIndex base index displacement)
417 pp_disp = ppr_disp displacement
418 pp_off p = pp_disp <> char '(' <> p <> char ')'
419 pp_reg r = pprReg L r
422 (Nothing, Nothing) -> pp_disp
423 (Just b, Nothing) -> pp_off (pp_reg b)
424 (Nothing, Just (r,i)) -> pp_off (pp_reg r <> comma <> int i)
425 (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
428 ppr_disp (ImmInt 0) = empty
429 ppr_disp imm = pprImm imm
434 #if sparc_TARGET_ARCH
435 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
437 pprAddr (AddrRegReg r1 r2)
438 = hcat [ pprReg r1, char '+', pprReg r2 ]
440 pprAddr (AddrRegImm r1 (ImmInt i))
442 | not (fits13Bits i) = largeOffsetError i
443 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
445 pp_sign = if i > 0 then char '+' else empty
447 pprAddr (AddrRegImm r1 (ImmInteger i))
449 | not (fits13Bits i) = largeOffsetError i
452 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
454 pp_sign = if i > 0 then char '+' else empty
456 pprAddr (AddrRegImm r1 imm)
457 = hcat [ pprReg r1, char '+', pprImm imm ]
459 #if powerpc_TARGET_ARCH
460 pprAddr (AddrRegReg r1 r2)
461 = error "PprMach.pprAddr (AddrRegReg) unimplemented"
463 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
464 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
465 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
469 %************************************************************************
471 \subsection{@pprInstr@: print an @Instr@}
473 %************************************************************************
476 pprInstr :: Instr -> Doc
478 --pprInstr (COMMENT s) = empty -- nuke 'em
480 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
481 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
482 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
483 ,IF_ARCH_powerpc( ((<>) (ptext SLIT("; ")) (ftext s))
487 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
489 pprInstr (SEGMENT TextSegment)
490 = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
491 ,IF_ARCH_sparc(ptext SLIT(".text\n\t.align 4") {-word boundary-}
492 ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
493 ,IF_ARCH_powerpc(ptext SLIT(".text\n.align 2")
496 pprInstr (SEGMENT DataSegment)
498 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
499 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
500 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
501 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
504 pprInstr (SEGMENT RoDataSegment)
506 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
507 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
508 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
509 ,IF_ARCH_powerpc(SLIT(".const_data\n.align 2")
512 pprInstr (LABEL clab)
514 pp_lab = pprCLabel_asm clab
517 if not (externallyVisibleCLabel clab) then
521 IF_ARCH_alpha(SLIT("\t.globl\t")
522 ,IF_ARCH_i386(SLIT(".globl ")
523 ,IF_ARCH_sparc(SLIT(".global\t")
524 ,IF_ARCH_powerpc(SLIT(".globl ")
526 , pp_lab, char '\n'],
531 pprInstr (ASCII False{-no backslash conversion-} str)
532 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
534 pprInstr (ASCII True str)
535 = vcat (map do1 (str ++ [chr 0]))
538 do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
541 hshow n | n >= 0 && n <= 255
542 = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
543 tab = "0123456789ABCDEF"
547 = vcat (concatMap (ppr_item s) xs)
550 #if alpha_TARGET_ARCH
551 ppr_item = error "ppr_item on Alpha"
553 #if sparc_TARGET_ARCH
554 -- copy n paste of x86 version
555 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
556 ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x]
557 ppr_item F (ImmFloat r)
558 = let bs = floatToBytes (fromRational r)
559 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
560 ppr_item DF (ImmDouble r)
561 = let bs = doubleToBytes (fromRational r)
562 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
565 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
566 ppr_item L x = [ptext SLIT("\t.long\t") <> pprImm x]
567 ppr_item F (ImmFloat r)
568 = let bs = floatToBytes (fromRational r)
569 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
570 ppr_item DF (ImmDouble r)
571 = let bs = doubleToBytes (fromRational r)
572 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
574 #if powerpc_TARGET_ARCH
575 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
576 ppr_item Bu x = [ptext SLIT("\t.byte\t") <> pprImm x]
577 ppr_item H x = [ptext SLIT("\t.byte\t") <> pprImm x]
578 ppr_item Hu x = [ptext SLIT("\t.byte\t") <> pprImm x]
579 ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x]
580 ppr_item F (ImmFloat r)
581 = let bs = floatToBytes (fromRational r)
582 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
583 ppr_item DF (ImmDouble r)
584 = let bs = doubleToBytes (fromRational r)
585 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
588 -- fall through to rest of (machine-specific) pprInstr...
591 %************************************************************************
593 \subsubsection{@pprInstr@ for an Alpha}
595 %************************************************************************
598 #if alpha_TARGET_ARCH
600 pprInstr (LD size reg addr)
610 pprInstr (LDA reg addr)
612 ptext SLIT("\tlda\t"),
618 pprInstr (LDAH reg addr)
620 ptext SLIT("\tldah\t"),
626 pprInstr (LDGP reg addr)
628 ptext SLIT("\tldgp\t"),
634 pprInstr (LDI size reg imm)
644 pprInstr (ST size reg addr)
656 ptext SLIT("\tclr\t"),
660 pprInstr (ABS size ri reg)
670 pprInstr (NEG size ov ri reg)
674 if ov then ptext SLIT("v\t") else char '\t',
680 pprInstr (ADD size ov reg1 ri reg2)
684 if ov then ptext SLIT("v\t") else char '\t',
692 pprInstr (SADD size scale reg1 ri reg2)
694 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
705 pprInstr (SUB size ov reg1 ri reg2)
709 if ov then ptext SLIT("v\t") else char '\t',
717 pprInstr (SSUB size scale reg1 ri reg2)
719 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
730 pprInstr (MUL size ov reg1 ri reg2)
734 if ov then ptext SLIT("v\t") else char '\t',
742 pprInstr (DIV size uns reg1 ri reg2)
746 if uns then ptext SLIT("u\t") else char '\t',
754 pprInstr (REM size uns reg1 ri reg2)
758 if uns then ptext SLIT("u\t") else char '\t',
766 pprInstr (NOT ri reg)
775 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
776 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
777 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
778 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
779 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
780 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
782 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
783 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
784 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
786 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
787 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
789 pprInstr (NOP) = ptext SLIT("\tnop")
791 pprInstr (CMP cond reg1 ri reg2)
805 ptext SLIT("\tfclr\t"),
809 pprInstr (FABS reg1 reg2)
811 ptext SLIT("\tfabs\t"),
817 pprInstr (FNEG size reg1 reg2)
827 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
828 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
829 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
830 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
832 pprInstr (CVTxy size1 size2 reg1 reg2)
836 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
843 pprInstr (FCMP size cond reg1 reg2 reg3)
856 pprInstr (FMOV reg1 reg2)
858 ptext SLIT("\tfmov\t"),
864 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
866 pprInstr (BI NEVER reg lab) = empty
868 pprInstr (BI cond reg lab)
878 pprInstr (BF cond reg lab)
889 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
891 pprInstr (JMP reg addr hint)
893 ptext SLIT("\tjmp\t"),
902 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
904 pprInstr (JSR reg addr n)
906 ptext SLIT("\tjsr\t"),
912 pprInstr (FUNBEGIN clab)
914 if (externallyVisibleCLabel clab) then
915 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
918 ptext SLIT("\t.ent "),
927 pp_lab = pprCLabel_asm clab
929 -- NEVER use commas within those string literals, cpp will ruin your day
930 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
931 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
932 ptext SLIT("4240"), char ',',
933 ptext SLIT("$26"), char ',',
934 ptext SLIT("0\n\t.prologue 1") ]
936 pprInstr (FUNEND clab)
937 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
940 Continue with Alpha-only printing bits and bobs:
944 pprRI (RIReg r) = pprReg r
945 pprRI (RIImm r) = pprImm r
947 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
948 pprRegRIReg name reg1 ri reg2
960 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
961 pprSizeRegRegReg name size reg1 reg2 reg3
974 #endif /* alpha_TARGET_ARCH */
977 %************************************************************************
979 \subsubsection{@pprInstr@ for an I386}
981 %************************************************************************
986 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
989 #if 0 /* #ifdef DEBUG */
990 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
994 pprInstr (MOV size src dst)
995 = pprSizeOpOp SLIT("mov") size src dst
996 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
997 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
999 -- here we do some patching, since the physical registers are only set late
1000 -- in the code generation.
1001 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1003 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1004 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1006 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1007 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
1009 = pprInstr (ADD size (OpImm displ) dst)
1010 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1012 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1013 = pprSizeOp SLIT("dec") size dst
1014 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1015 = pprSizeOp SLIT("inc") size dst
1016 pprInstr (ADD size src dst)
1017 = pprSizeOpOp SLIT("add") size src dst
1018 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1019 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1021 {- A hack. The Intel documentation says that "The two and three
1022 operand forms [of IMUL] may also be used with unsigned operands
1023 because the lower half of the product is the same regardless if
1024 (sic) the operands are signed or unsigned. The CF and OF flags,
1025 however, cannot be used to determine if the upper half of the
1026 result is non-zero." So there.
1028 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1030 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1031 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1032 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1033 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1034 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1036 pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst
1037 pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst
1038 pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst
1039 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1041 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
1042 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1043 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1044 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1045 pprInstr PUSHA = ptext SLIT("\tpushal")
1046 pprInstr POPA = ptext SLIT("\tpopal")
1048 pprInstr NOP = ptext SLIT("\tnop")
1049 pprInstr CLTD = ptext SLIT("\tcltd")
1051 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
1053 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1055 pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1056 pprInstr (JMP dsts op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
1057 pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1058 pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg L reg)
1060 -- First bool indicates signedness; second whether quot or rem
1061 pprInstr (IQUOT sz src dst) = pprInstr_quotRem True True sz src dst
1062 pprInstr (IREM sz src dst) = pprInstr_quotRem True False sz src dst
1064 pprInstr (QUOT sz src dst) = pprInstr_quotRem False True sz src dst
1065 pprInstr (REM sz src dst) = pprInstr_quotRem False False sz src dst
1067 pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo
1070 -- Simulating a flat register set on the x86 FP stack is tricky.
1071 -- you have to free %st(7) before pushing anything on the FP reg stack
1072 -- so as to preclude the possibility of a FP stack overflow exception.
1073 pprInstr g@(GMOV src dst)
1077 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1079 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1080 pprInstr g@(GLD sz addr dst)
1081 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1082 pprAddr addr, gsemi, gpop dst 1])
1084 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1085 pprInstr g@(GST sz src addr)
1086 = pprG g (hcat [gtab, gpush src 0, gsemi,
1087 text "fstp", pprSize sz, gsp, pprAddr addr])
1089 pprInstr g@(GLDZ dst)
1090 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1091 pprInstr g@(GLD1 dst)
1092 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1094 pprInstr g@(GFTOI src dst)
1095 = pprInstr (GDTOI src dst)
1096 pprInstr g@(GDTOI src dst)
1097 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1098 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1101 pprInstr g@(GITOF src dst)
1102 = pprInstr (GITOD src dst)
1103 pprInstr g@(GITOD src dst)
1104 = pprG g (hcat [gtab, text "pushl ", pprReg L src,
1105 text " ; ffree %st(7); fildl (%esp) ; ",
1106 gpop dst 1, text " ; addl $4,%esp"])
1108 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1109 this far into the jungle AND you give a Rat's Ass (tm) what's going
1110 on, here's the deal. Generate code to do a floating point comparison
1111 of src1 and src2, of kind cond, and set the Zero flag if true.
1113 The complications are to do with handling NaNs correctly. We want the
1114 property that if either argument is NaN, then the result of the
1115 comparison is False ... except if we're comparing for inequality,
1116 in which case the answer is True.
1118 Here's how the general (non-inequality) case works. As an
1119 example, consider generating the an equality test:
1121 pushl %eax -- we need to mess with this
1122 <get src1 to top of FPU stack>
1123 fcomp <src2 location in FPU stack> and pop pushed src1
1124 -- Result of comparison is in FPU Status Register bits
1126 fstsw %ax -- Move FPU Status Reg to %ax
1127 sahf -- move C3 C2 C0 from %ax to integer flag reg
1128 -- now the serious magic begins
1129 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1130 sete %al -- %al = if arg1 == arg2 then 1 else 0
1131 andb %ah,%al -- %al &= %ah
1132 -- so %al == 1 iff (comparable && same); else it holds 0
1133 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1134 else %al == 0xFF, ZeroFlag=0
1135 -- the zero flag is now set as we desire.
1138 The special case of inequality differs thusly:
1140 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1141 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1142 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1143 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1144 else (%al == 0xFF, ZF=0)
1146 pprInstr g@(GCMP cond src1 src2)
1147 | case cond of { NE -> True; other -> False }
1149 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1150 hcat [gtab, text "fcomp ", greg src2 1,
1151 text "; fstsw %ax ; sahf ; setpe %ah"],
1152 hcat [gtab, text "setne %al ; ",
1153 text "orb %ah,%al ; decb %al ; popl %eax"]
1157 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1158 hcat [gtab, text "fcomp ", greg src2 1,
1159 text "; fstsw %ax ; sahf ; setpo %ah"],
1160 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1161 text "andb %ah,%al ; decb %al ; popl %eax"]
1164 {- On the 486, the flags set by FP compare are the unsigned ones!
1165 (This looks like a HACK to me. WDP 96/03)
1167 fix_FP_cond :: Cond -> Cond
1168 fix_FP_cond GE = GEU
1169 fix_FP_cond GTT = GU
1170 fix_FP_cond LTT = LU
1171 fix_FP_cond LE = LEU
1172 fix_FP_cond EQQ = EQQ
1174 -- there should be no others
1177 pprInstr g@(GABS sz src dst)
1178 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1179 pprInstr g@(GNEG sz src dst)
1180 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1182 pprInstr g@(GSQRT sz src dst)
1183 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1184 hcat [gtab, gcoerceto sz, gpop dst 1])
1185 pprInstr g@(GSIN sz src dst)
1186 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1187 hcat [gtab, gcoerceto sz, gpop dst 1])
1188 pprInstr g@(GCOS sz src dst)
1189 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1190 hcat [gtab, gcoerceto sz, gpop dst 1])
1191 pprInstr g@(GTAN sz src dst)
1192 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1193 gpush src 0, text " ; fptan ; ",
1194 text " fstp %st(0)"] $$
1195 hcat [gtab, gcoerceto sz, gpop dst 1])
1197 -- In the translations for GADD, GMUL, GSUB and GDIV,
1198 -- the first two cases are mere optimisations. The otherwise clause
1199 -- generates correct code under all circumstances.
1201 pprInstr g@(GADD sz src1 src2 dst)
1203 = pprG g (text "\t#GADD-xxxcase1" $$
1204 hcat [gtab, gpush src2 0,
1205 text " ; faddp %st(0),", greg src1 1])
1207 = pprG g (text "\t#GADD-xxxcase2" $$
1208 hcat [gtab, gpush src1 0,
1209 text " ; faddp %st(0),", greg src2 1])
1211 = pprG g (hcat [gtab, gpush src1 0,
1212 text " ; fadd ", greg src2 1, text ",%st(0)",
1216 pprInstr g@(GMUL sz src1 src2 dst)
1218 = pprG g (text "\t#GMUL-xxxcase1" $$
1219 hcat [gtab, gpush src2 0,
1220 text " ; fmulp %st(0),", greg src1 1])
1222 = pprG g (text "\t#GMUL-xxxcase2" $$
1223 hcat [gtab, gpush src1 0,
1224 text " ; fmulp %st(0),", greg src2 1])
1226 = pprG g (hcat [gtab, gpush src1 0,
1227 text " ; fmul ", greg src2 1, text ",%st(0)",
1231 pprInstr g@(GSUB sz src1 src2 dst)
1233 = pprG g (text "\t#GSUB-xxxcase1" $$
1234 hcat [gtab, gpush src2 0,
1235 text " ; fsubrp %st(0),", greg src1 1])
1237 = pprG g (text "\t#GSUB-xxxcase2" $$
1238 hcat [gtab, gpush src1 0,
1239 text " ; fsubp %st(0),", greg src2 1])
1241 = pprG g (hcat [gtab, gpush src1 0,
1242 text " ; fsub ", greg src2 1, text ",%st(0)",
1246 pprInstr g@(GDIV sz src1 src2 dst)
1248 = pprG g (text "\t#GDIV-xxxcase1" $$
1249 hcat [gtab, gpush src2 0,
1250 text " ; fdivrp %st(0),", greg src1 1])
1252 = pprG g (text "\t#GDIV-xxxcase2" $$
1253 hcat [gtab, gpush src1 0,
1254 text " ; fdivp %st(0),", greg src2 1])
1256 = pprG g (hcat [gtab, gpush src1 0,
1257 text " ; fdiv ", greg src2 1, text ",%st(0)",
1262 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1263 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1267 pprInstr_quotRem signed isQuot sz src dst
1268 | case sz of L -> False; _ -> True
1269 = panic "pprInstr_quotRem: dunno how to do non-32bit operands"
1272 (text "\t# BEGIN " <> fakeInsn),
1273 (text "\tpushl $0; pushl %eax; pushl %edx; pushl " <> pprOperand sz src),
1274 (text "\tmovl " <> pprOperand sz dst <> text ",%eax; " <> widen_to_64),
1275 (x86op <> text " 0(%esp); movl " <> text resReg <> text ",12(%esp)"),
1276 (text "\tpopl %edx; popl %edx; popl %eax; popl " <> pprOperand sz dst),
1277 (text "\t# END " <> fakeInsn)
1280 widen_to_64 | signed = text "cltd"
1281 | not signed = text "xorl %edx,%edx"
1282 x86op = if signed then text "\tidivl" else text "\tdivl"
1283 resReg = if isQuot then "%eax" else "%edx"
1284 opStr | signed = if isQuot then "IQUOT" else "IREM"
1285 | not signed = if isQuot then "QUOT" else "REM"
1286 fakeInsn = text opStr <+> pprOperand sz src
1287 <> char ',' <+> pprOperand sz dst
1289 -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg
1290 pprInstr_imul64 hi_reg lo_reg
1291 = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg
1292 pp_hi_reg = pprReg L hi_reg
1293 pp_lo_reg = pprReg L lo_reg
1296 text "\t# BEGIN " <> fakeInsn,
1297 text "\tpushl" <+> pp_hi_reg <> text" ; pushl" <+> pp_lo_reg,
1298 text "\tpushl %eax ; pushl %edx",
1299 text "\tmovl 12(%esp), %eax ; imull 8(%esp)",
1300 text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)",
1301 text "\tpopl %edx ; popl %eax",
1302 text "\tpopl" <+> pp_lo_reg <> text " ; popl" <+> pp_hi_reg,
1303 text "\t# END " <> fakeInsn
1307 --------------------------
1309 -- coerce %st(0) to the specified size
1310 gcoerceto DF = empty
1311 gcoerceto F = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1314 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1316 = hcat [text "fstp ", greg reg offset]
1318 bogus = text "\tbogus"
1319 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1324 gregno (RealReg i) = i
1325 gregno other = --pprPanic "gregno" (ppr other)
1326 999 -- bogus; only needed for debug printing
1328 pprG :: Instr -> Doc -> Doc
1330 = (char '#' <> pprGInstr fake) $$ actual
1332 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst
1333 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1334 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1336 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst
1337 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst
1339 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
1340 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1342 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
1343 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1345 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") DF co src dst
1346 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1347 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1348 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1349 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1350 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1351 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1353 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1354 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1355 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1356 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1359 Continue with I386-only printing bits and bobs:
1361 pprDollImm :: Imm -> Doc
1363 pprDollImm i = ptext SLIT("$") <> pprImm i
1365 pprOperand :: Size -> Operand -> Doc
1366 pprOperand s (OpReg r) = pprReg s r
1367 pprOperand s (OpImm i) = pprDollImm i
1368 pprOperand s (OpAddr ea) = pprAddr ea
1370 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
1371 pprSizeImmOp name size imm op1
1383 pprSizeOp :: LitString -> Size -> Operand -> Doc
1384 pprSizeOp name size op1
1393 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1394 pprSizeOpOp name size op1 op2
1400 pprOperand size op1,
1405 pprSizeByteOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1406 pprSizeByteOpOp name size op1 op2
1417 pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> Doc
1418 pprSizeOpReg name size op1 reg
1424 pprOperand size op1,
1429 pprSizeReg :: LitString -> Size -> Reg -> Doc
1430 pprSizeReg name size reg1
1439 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1440 pprSizeRegReg name size reg1 reg2
1451 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
1452 pprCondRegReg name size cond reg1 reg2
1463 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
1464 pprSizeSizeRegReg name size1 size2 reg1 reg2
1477 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1478 pprSizeRegRegReg name size reg1 reg2 reg3
1491 pprSizeAddr :: LitString -> Size -> MachRegsAddr -> Doc
1492 pprSizeAddr name size op
1501 pprSizeAddrReg :: LitString -> Size -> MachRegsAddr -> Reg -> Doc
1502 pprSizeAddrReg name size op dst
1513 pprSizeRegAddr :: LitString -> Size -> Reg -> MachRegsAddr -> Doc
1514 pprSizeRegAddr name size src op
1525 pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1526 pprOpOp name size op1 op2
1530 pprOperand size op1,
1535 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
1536 pprSizeOpOpCoerce name size1 size2 op1 op2
1537 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1538 pprOperand size1 op1,
1540 pprOperand size2 op2
1543 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1544 pprCondInstr name cond arg
1545 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1547 #endif /* i386_TARGET_ARCH */
1550 %************************************************************************
1552 \subsubsection{@pprInstr@ for a SPARC}
1554 %************************************************************************
1557 #if sparc_TARGET_ARCH
1559 -- a clumsy hack for now, to handle possible double alignment problems
1561 -- even clumsier, to allow for RegReg regs that show when doing indexed
1562 -- reads (bytearrays).
1565 -- Translate to the following:
1568 -- ld [g1+4],%f(n+1)
1569 -- sub g1,g2,g1 -- to restore g1
1570 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1572 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1573 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1574 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1575 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1580 -- ld [addr+4],%f(n+1)
1581 pprInstr (LD DF addr reg) | isJust off_addr
1583 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1584 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1587 off_addr = addrOffset addr 4
1588 addr2 = case off_addr of Just x -> x
1591 pprInstr (LD size addr reg)
1602 -- The same clumsy hack as above
1604 -- Translate to the following:
1607 -- st %f(n+1),[g1+4]
1608 -- sub g1,g2,g1 -- to restore g1
1609 pprInstr (ST DF reg (AddrRegReg g1 g2))
1611 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1612 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1614 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1615 pprReg g1, ptext SLIT("+4]")],
1616 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1621 -- st %f(n+1),[addr+4]
1622 pprInstr (ST DF reg addr) | isJust off_addr
1624 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1625 pprAddr addr, rbrack],
1626 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1627 pprAddr addr2, rbrack]
1630 off_addr = addrOffset addr 4
1631 addr2 = case off_addr of Just x -> x
1633 -- no distinction is made between signed and unsigned bytes on stores for the
1634 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1635 -- so we call a special-purpose pprSize for ST..
1637 pprInstr (ST size reg addr)
1648 pprInstr (ADD x cc reg1 ri reg2)
1649 | not x && not cc && riZero ri
1650 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1652 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1654 pprInstr (SUB x cc reg1 ri reg2)
1655 | not x && cc && reg2 == g0
1656 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1657 | not x && not cc && riZero ri
1658 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1660 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1662 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1663 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1665 pprInstr (OR b reg1 ri reg2)
1666 | not b && reg1 == g0
1667 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1669 RIReg rrr | rrr == reg2 -> empty
1672 = pprRegRIReg SLIT("or") b reg1 ri reg2
1674 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1676 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1677 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1679 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1680 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1681 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1683 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1684 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1685 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1687 pprInstr (SETHI imm reg)
1689 ptext SLIT("\tsethi\t"),
1695 pprInstr NOP = ptext SLIT("\tnop")
1697 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1698 pprInstr (FABS DF reg1 reg2)
1699 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1700 (if (reg1 == reg2) then empty
1701 else (<>) (char '\n')
1702 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1704 pprInstr (FADD size reg1 reg2 reg3)
1705 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1706 pprInstr (FCMP e size reg1 reg2)
1707 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1708 pprInstr (FDIV size reg1 reg2 reg3)
1709 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1711 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1712 pprInstr (FMOV DF reg1 reg2)
1713 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1714 (if (reg1 == reg2) then empty
1715 else (<>) (char '\n')
1716 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1718 pprInstr (FMUL size reg1 reg2 reg3)
1719 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1721 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1722 pprInstr (FNEG DF reg1 reg2)
1723 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1724 (if (reg1 == reg2) then empty
1725 else (<>) (char '\n')
1726 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1728 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1729 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1730 pprInstr (FxTOy size1 size2 reg1 reg2)
1743 pprReg reg1, comma, pprReg reg2
1747 pprInstr (BI cond b lab)
1749 ptext SLIT("\tb"), pprCond cond,
1750 if b then pp_comma_a else empty,
1755 pprInstr (BF cond b lab)
1757 ptext SLIT("\tfb"), pprCond cond,
1758 if b then pp_comma_a else empty,
1763 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1765 pprInstr (CALL (Left imm) n _)
1766 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1767 pprInstr (CALL (Right reg) n _)
1768 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1771 Continue with SPARC-only printing bits and bobs:
1774 pprRI (RIReg r) = pprReg r
1775 pprRI (RIImm r) = pprImm r
1777 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1778 pprSizeRegReg name size reg1 reg2
1783 F -> ptext SLIT("s\t")
1784 DF -> ptext SLIT("d\t")),
1790 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1791 pprSizeRegRegReg name size reg1 reg2 reg3
1796 F -> ptext SLIT("s\t")
1797 DF -> ptext SLIT("d\t")),
1805 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
1806 pprRegRIReg name b reg1 ri reg2
1810 if b then ptext SLIT("cc\t") else char '\t',
1818 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
1819 pprRIReg name b ri reg1
1823 if b then ptext SLIT("cc\t") else char '\t',
1829 pp_ld_lbracket = ptext SLIT("\tld\t[")
1830 pp_rbracket_comma = text "],"
1831 pp_comma_lbracket = text ",["
1832 pp_comma_a = text ",a"
1834 #endif /* sparc_TARGET_ARCH */
1837 %************************************************************************
1839 \subsubsection{@pprInstr@ for PowerPC}
1841 %************************************************************************
1844 #if powerpc_TARGET_ARCH
1845 pprInstr (LD sz reg addr) = hcat [
1861 pprInstr (ST sz reg addr) = hcat [
1870 pprInstr (STU sz reg addr) = hcat [
1879 pprInstr (LIS reg imm) = hcat [
1887 pprInstr (LI reg imm) = hcat [
1895 pprInstr (MR reg1 reg2)
1896 | reg1 == reg2 = empty
1897 | otherwise = hcat [
1899 case regClass reg1 of
1900 RcInteger -> ptext SLIT("mr")
1901 _ -> ptext SLIT("fmr"),
1907 pprInstr (CMP sz reg ri) = hcat [
1923 pprInstr (CMPL sz reg ri) = hcat [
1939 pprInstr (BCC cond lbl) = hcat [
1947 pprInstr (MTCTR reg) = hcat [
1949 ptext SLIT("mtctr"),
1953 pprInstr (BCTR _) = hcat [
1957 pprInstr (BL imm _) = hcat [
1963 pprInstr (BCTRL _) = hcat [
1967 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
1968 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
1969 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
1970 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
1971 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
1972 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
1974 -- for some reason, "andi" doesn't exist.
1975 -- we'll use "andi." instead.
1976 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
1978 ptext SLIT("andi."),
1986 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 (toUI16 ri)
1988 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 (toUI16 ri)
1989 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 (toUI16 ri)
1991 pprInstr (XORIS reg1 reg2 imm) = hcat [
1993 ptext SLIT("xoris"),
2002 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 ri
2003 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 ri
2004 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 ri
2005 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2006 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2008 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2009 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2010 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2011 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2012 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2014 pprInstr (FCMP reg1 reg2) = hcat [
2016 ptext SLIT("fcmpu\tcr0, "),
2017 -- Note: we're using fcmpu, not fcmpo
2018 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2019 -- We don't handle invalid fp ops, so we don't care
2025 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2027 pprInstr _ = ptext SLIT("something")
2029 pprLogic op reg1 reg2 ri = hcat [
2034 RIImm _ -> char 'i',
2043 pprUnary op reg1 reg2 = hcat [
2052 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2065 pprRI (RIReg r) = pprReg r
2066 pprRI (RIImm r) = pprImm r
2069 pprFSize F = char 's'
2071 -- hack to ensure that negative vals come out in non-negative form
2072 -- (assuming that fromIntegral{Int->Word16} will do a 'c-style'
2073 -- conversion, and not throw a fit/exception.)
2075 toUI16 (RIImm (ImmInt x))
2076 | x < 0 = RIImm (ImmInt (fromIntegral ((fromIntegral x) :: Word16)))
2077 toUI16 (RIImm (ImmInteger x))
2078 | x < 0 = RIImm (ImmInt (fromIntegral ((fromIntegral x) :: Word16)))
2082 The Mach-O object file format used in Darwin/Mac OS X needs a so-called
2083 "symbol stub" for every function that might be imported from a dynamic
2085 The stubs are always the same, and they are all output at the end of the
2086 generated assembly (see AsmCodeGen.lhs), so we don't use the Instr datatype.
2087 Instead, we just pretty-print it directly.
2090 #if darwin_TARGET_OS
2091 pprDyldSymbolStub fn =
2093 ptext SLIT(".symbol_stub"),
2094 ptext SLIT("L_") <> ftext fn <> ptext SLIT("$stub:"),
2095 ptext SLIT("\t.indirect_symbol _") <> ftext fn,
2096 ptext SLIT("\tlis r11,ha16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
2097 ptext SLIT("\tlwz r12,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)(r11)"),
2098 ptext SLIT("\tmtctr r12"),
2099 ptext SLIT("\taddi r11,r11,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
2100 ptext SLIT("\tbctr"),
2101 ptext SLIT(".lazy_symbol_pointer"),
2102 ptext SLIT("L_") <> ftext fn <> ptext SLIT("$lazy_ptr:"),
2103 ptext SLIT("\t.indirect_symbol _") <> ftext fn,
2104 ptext SLIT("\t.long dyld_stub_binding_helper")
2109 #endif /* powerpc_TARGET_ARCH */
2113 #if __GLASGOW_HASKELL__ >= 504
2114 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
2115 newFloatArray = newArray_
2117 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
2118 newDoubleArray = newArray_
2120 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2121 castFloatToCharArray = castSTUArray
2123 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2124 castDoubleToCharArray = castSTUArray
2126 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
2127 writeFloatArray = writeArray
2129 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
2130 writeDoubleArray = writeArray
2132 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
2133 readCharArray arr i = do
2134 w <- readArray arr i
2135 return $! (chr (fromIntegral w))
2139 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2140 castFloatToCharArray = return
2142 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2145 castDoubleToCharArray = return
2149 -- floatToBytes and doubleToBytes convert to the host's byte
2150 -- order. Providing that we're not cross-compiling for a
2151 -- target with the opposite endianness, this should work ok
2154 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2155 -- could they be merged?
2157 floatToBytes :: Float -> [Int]
2160 arr <- newFloatArray ((0::Int),3)
2161 writeFloatArray arr 0 f
2162 arr <- castFloatToCharArray arr
2163 i0 <- readCharArray arr 0
2164 i1 <- readCharArray arr 1
2165 i2 <- readCharArray arr 2
2166 i3 <- readCharArray arr 3
2167 return (map ord [i0,i1,i2,i3])
2170 doubleToBytes :: Double -> [Int]
2173 arr <- newDoubleArray ((0::Int),7)
2174 writeDoubleArray arr 0 d
2175 arr <- castDoubleToCharArray arr
2176 i0 <- readCharArray arr 0
2177 i1 <- readCharArray arr 1
2178 i2 <- readCharArray arr 2
2179 i3 <- readCharArray arr 3
2180 i4 <- readCharArray arr 4
2181 i5 <- readCharArray arr 5
2182 i6 <- readCharArray arr 6
2183 i7 <- readCharArray arr 7
2184 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])