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
181 ppr_reg_no :: Int -> Doc
184 0 -> SLIT("r0"); 1 -> SLIT("r1");
185 2 -> SLIT("r2"); 3 -> SLIT("r3");
186 4 -> SLIT("r4"); 5 -> SLIT("r5");
187 6 -> SLIT("r6"); 7 -> SLIT("r7");
188 8 -> SLIT("r8"); 9 -> SLIT("r9");
189 10 -> SLIT("r10"); 11 -> SLIT("r11");
190 12 -> SLIT("r12"); 13 -> SLIT("r13");
191 14 -> SLIT("r14"); 15 -> SLIT("r15");
192 16 -> SLIT("r16"); 17 -> SLIT("r17");
193 18 -> SLIT("r18"); 19 -> SLIT("r19");
194 20 -> SLIT("r20"); 21 -> SLIT("r21");
195 22 -> SLIT("r22"); 23 -> SLIT("r23");
196 24 -> SLIT("r24"); 25 -> SLIT("r25");
197 26 -> SLIT("r26"); 27 -> SLIT("r27");
198 28 -> SLIT("r28"); 29 -> SLIT("r29");
199 30 -> SLIT("r30"); 31 -> SLIT("r31");
200 32 -> SLIT("f0"); 33 -> SLIT("f1");
201 34 -> SLIT("f2"); 35 -> SLIT("f3");
202 36 -> SLIT("f4"); 37 -> SLIT("f5");
203 38 -> SLIT("f6"); 39 -> SLIT("f7");
204 40 -> SLIT("f8"); 41 -> SLIT("f9");
205 42 -> SLIT("f10"); 43 -> SLIT("f11");
206 44 -> SLIT("f12"); 45 -> SLIT("f13");
207 46 -> SLIT("f14"); 47 -> SLIT("f15");
208 48 -> SLIT("f16"); 49 -> SLIT("f17");
209 50 -> SLIT("f18"); 51 -> SLIT("f19");
210 52 -> SLIT("f20"); 53 -> SLIT("f21");
211 54 -> SLIT("f22"); 55 -> SLIT("f23");
212 56 -> SLIT("f24"); 57 -> SLIT("f25");
213 58 -> SLIT("f26"); 59 -> SLIT("f27");
214 60 -> SLIT("f28"); 61 -> SLIT("f29");
215 62 -> SLIT("f30"); 63 -> SLIT("f31");
216 _ -> SLIT("very naughty powerpc register")
219 ppr_reg_no :: Int -> Doc
220 ppr_reg_no i | i <= 31 = int i -- GPRs
221 | i <= 63 = int (i-32) -- FPRs
222 | otherwise = ptext SLIT("very naughty powerpc register")
227 %************************************************************************
229 \subsection{@pprSize@: print a @Size@}
231 %************************************************************************
234 pprSize :: Size -> Doc
236 pprSize x = ptext (case x of
237 #if alpha_TARGET_ARCH
240 -- W -> SLIT("w") UNUSED
241 -- Wu -> SLIT("wu") UNUSED
244 -- FF -> SLIT("f") UNUSED
245 -- DF -> SLIT("d") UNUSED
246 -- GF -> SLIT("g") UNUSED
247 -- SF -> SLIT("s") UNUSED
261 #if sparc_TARGET_ARCH
270 pprStSize :: Size -> Doc
271 pprStSize x = ptext (case x of
280 #if powerpc_TARGET_ARCH
292 %************************************************************************
294 \subsection{@pprCond@: print a @Cond@}
296 %************************************************************************
299 pprCond :: Cond -> Doc
301 pprCond c = ptext (case c of {
302 #if alpha_TARGET_ARCH
313 GEU -> SLIT("ae"); LU -> SLIT("b");
314 EQQ -> SLIT("e"); GTT -> SLIT("g");
315 GE -> SLIT("ge"); GU -> SLIT("a");
316 LTT -> SLIT("l"); LE -> SLIT("le");
317 LEU -> SLIT("be"); NE -> SLIT("ne");
318 NEG -> SLIT("s"); POS -> SLIT("ns");
319 CARRY -> SLIT("c"); OFLO -> SLIT("o");
320 ALWAYS -> SLIT("mp") -- hack
322 #if sparc_TARGET_ARCH
323 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
324 GEU -> SLIT("geu"); LU -> SLIT("lu");
325 EQQ -> SLIT("e"); GTT -> SLIT("g");
326 GE -> SLIT("ge"); GU -> SLIT("gu");
327 LTT -> SLIT("l"); LE -> SLIT("le");
328 LEU -> SLIT("leu"); NE -> SLIT("ne");
329 NEG -> SLIT("neg"); POS -> SLIT("pos");
330 VC -> SLIT("vc"); VS -> SLIT("vs")
332 #if powerpc_TARGET_ARCH
334 EQQ -> SLIT("eq"); NE -> SLIT("ne");
335 LTT -> SLIT("lt"); GE -> SLIT("ge");
336 GTT -> SLIT("gt"); LE -> SLIT("le");
337 LU -> SLIT("lt"); GEU -> SLIT("ge");
338 GU -> SLIT("gt"); LEU -> SLIT("le");
343 %************************************************************************
345 \subsection{@pprImm@: print an @Imm@}
347 %************************************************************************
352 pprImm (ImmInt i) = int i
353 pprImm (ImmInteger i) = integer i
354 pprImm (ImmCLbl l) = (if labelDynamic l then text "__imp_" else empty)
356 pprImm (ImmIndex l i) = (if labelDynamic l then text "__imp_" else empty)
357 <> pprCLabel_asm l <> char '+' <> int i
358 pprImm (ImmLit s) = s
360 pprImm (ImmLab dll s) = (if underscorePrefix then char '_' else empty)
361 <> (if dll then text "_imp__" else empty)
364 #if sparc_TARGET_ARCH
366 = hcat [ pp_lo, pprImm i, rparen ]
371 = hcat [ pp_hi, pprImm i, rparen ]
375 #if powerpc_TARGET_ARCH
378 = hcat [ pp_lo, pprImm i, rparen ]
383 = hcat [ pp_hi, pprImm i, rparen ]
388 = hcat [ pp_ha, pprImm i, rparen ]
393 = pprImm i <> text "@l"
396 = pprImm i <> text "@h"
399 = pprImm i <> text "@ha"
404 %************************************************************************
406 \subsection{@pprAddr@: print an @Addr@}
408 %************************************************************************
411 pprAddr :: MachRegsAddr -> Doc
413 #if alpha_TARGET_ARCH
414 pprAddr (AddrReg r) = parens (pprReg r)
415 pprAddr (AddrImm i) = pprImm i
416 pprAddr (AddrRegImm r1 i)
417 = (<>) (pprImm i) (parens (pprReg r1))
423 pprAddr (ImmAddr imm off)
424 = let pp_imm = pprImm imm
428 else if (off < 0) then
431 pp_imm <> char '+' <> int off
433 pprAddr (AddrBaseIndex base index displacement)
435 pp_disp = ppr_disp displacement
436 pp_off p = pp_disp <> char '(' <> p <> char ')'
437 pp_reg r = pprReg L r
440 (Nothing, Nothing) -> pp_disp
441 (Just b, Nothing) -> pp_off (pp_reg b)
442 (Nothing, Just (r,i)) -> pp_off (pp_reg r <> comma <> int i)
443 (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
446 ppr_disp (ImmInt 0) = empty
447 ppr_disp imm = pprImm imm
452 #if sparc_TARGET_ARCH
453 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
455 pprAddr (AddrRegReg r1 r2)
456 = hcat [ pprReg r1, char '+', pprReg r2 ]
458 pprAddr (AddrRegImm r1 (ImmInt i))
460 | not (fits13Bits i) = largeOffsetError i
461 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
463 pp_sign = if i > 0 then char '+' else empty
465 pprAddr (AddrRegImm r1 (ImmInteger i))
467 | not (fits13Bits i) = largeOffsetError i
470 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
472 pp_sign = if i > 0 then char '+' else empty
474 pprAddr (AddrRegImm r1 imm)
475 = hcat [ pprReg r1, char '+', pprImm imm ]
477 #if powerpc_TARGET_ARCH
478 pprAddr (AddrRegReg r1 r2)
479 = error "PprMach.pprAddr (AddrRegReg) unimplemented"
481 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
482 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
483 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
487 %************************************************************************
489 \subsection{@pprInstr@: print an @Instr@}
491 %************************************************************************
494 pprInstr :: Instr -> Doc
496 --pprInstr (COMMENT s) = empty -- nuke 'em
498 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
499 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
500 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
501 ,IF_ARCH_powerpc( ((<>) (ptext SLIT("; ")) (ftext s))
505 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
507 pprInstr (SEGMENT TextSegment)
508 = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
509 ,IF_ARCH_sparc(ptext SLIT(".text\n\t.align 4") {-word boundary-}
510 ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
511 ,IF_ARCH_powerpc(ptext SLIT(".text\n.align 2")
514 pprInstr (SEGMENT DataSegment)
516 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
517 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
518 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
519 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
522 pprInstr (SEGMENT RoDataSegment)
524 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
525 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
526 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
527 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
528 SLIT(".section .rodata\n\t.align 2"))
531 pprInstr (LABEL clab)
533 pp_lab = pprCLabel_asm clab
536 if not (externallyVisibleCLabel clab) then
540 IF_ARCH_alpha(SLIT("\t.globl\t")
541 ,IF_ARCH_i386(SLIT(".globl ")
542 ,IF_ARCH_sparc(SLIT(".global\t")
543 ,IF_ARCH_powerpc(SLIT(".globl ")
545 , pp_lab, char '\n'],
550 pprInstr (ASCII False{-no backslash conversion-} str)
551 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
553 pprInstr (ASCII True str)
554 = vcat (map do1 (str ++ [chr 0]))
557 do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
560 hshow n | n >= 0 && n <= 255
561 = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
562 tab = "0123456789ABCDEF"
566 = vcat (concatMap (ppr_item s) xs)
569 #if alpha_TARGET_ARCH
570 ppr_item = error "ppr_item on Alpha"
572 #if sparc_TARGET_ARCH
573 -- copy n paste of x86 version
574 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
575 ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x]
576 ppr_item F (ImmFloat r)
577 = let bs = floatToBytes (fromRational r)
578 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
579 ppr_item DF (ImmDouble r)
580 = let bs = doubleToBytes (fromRational r)
581 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
584 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
585 ppr_item L x = [ptext SLIT("\t.long\t") <> pprImm x]
586 ppr_item F (ImmFloat r)
587 = let bs = floatToBytes (fromRational r)
588 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
589 ppr_item DF (ImmDouble r)
590 = let bs = doubleToBytes (fromRational r)
591 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
593 #if powerpc_TARGET_ARCH
594 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
595 ppr_item Bu x = [ptext SLIT("\t.byte\t") <> pprImm x]
596 ppr_item H x = [ptext SLIT("\t.short\t") <> pprImm x]
597 ppr_item Hu x = [ptext SLIT("\t.short\t") <> pprImm x]
598 ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x]
599 ppr_item F (ImmFloat r)
600 = let bs = floatToBytes (fromRational r)
601 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
602 ppr_item DF (ImmDouble r)
603 = let bs = doubleToBytes (fromRational r)
604 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
607 -- fall through to rest of (machine-specific) pprInstr...
610 %************************************************************************
612 \subsubsection{@pprInstr@ for an Alpha}
614 %************************************************************************
617 #if alpha_TARGET_ARCH
619 pprInstr (LD size reg addr)
629 pprInstr (LDA reg addr)
631 ptext SLIT("\tlda\t"),
637 pprInstr (LDAH reg addr)
639 ptext SLIT("\tldah\t"),
645 pprInstr (LDGP reg addr)
647 ptext SLIT("\tldgp\t"),
653 pprInstr (LDI size reg imm)
663 pprInstr (ST size reg addr)
675 ptext SLIT("\tclr\t"),
679 pprInstr (ABS size ri reg)
689 pprInstr (NEG size ov ri reg)
693 if ov then ptext SLIT("v\t") else char '\t',
699 pprInstr (ADD size ov reg1 ri reg2)
703 if ov then ptext SLIT("v\t") else char '\t',
711 pprInstr (SADD size scale reg1 ri reg2)
713 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
724 pprInstr (SUB size ov reg1 ri reg2)
728 if ov then ptext SLIT("v\t") else char '\t',
736 pprInstr (SSUB size scale reg1 ri reg2)
738 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
749 pprInstr (MUL size ov reg1 ri reg2)
753 if ov then ptext SLIT("v\t") else char '\t',
761 pprInstr (DIV size uns reg1 ri reg2)
765 if uns then ptext SLIT("u\t") else char '\t',
773 pprInstr (REM size uns reg1 ri reg2)
777 if uns then ptext SLIT("u\t") else char '\t',
785 pprInstr (NOT ri reg)
794 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
795 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
796 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
797 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
798 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
799 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
801 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
802 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
803 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
805 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
806 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
808 pprInstr (NOP) = ptext SLIT("\tnop")
810 pprInstr (CMP cond reg1 ri reg2)
824 ptext SLIT("\tfclr\t"),
828 pprInstr (FABS reg1 reg2)
830 ptext SLIT("\tfabs\t"),
836 pprInstr (FNEG size reg1 reg2)
846 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
847 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
848 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
849 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
851 pprInstr (CVTxy size1 size2 reg1 reg2)
855 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
862 pprInstr (FCMP size cond reg1 reg2 reg3)
875 pprInstr (FMOV reg1 reg2)
877 ptext SLIT("\tfmov\t"),
883 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
885 pprInstr (BI NEVER reg lab) = empty
887 pprInstr (BI cond reg lab)
897 pprInstr (BF cond reg lab)
908 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
910 pprInstr (JMP reg addr hint)
912 ptext SLIT("\tjmp\t"),
921 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
923 pprInstr (JSR reg addr n)
925 ptext SLIT("\tjsr\t"),
931 pprInstr (FUNBEGIN clab)
933 if (externallyVisibleCLabel clab) then
934 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
937 ptext SLIT("\t.ent "),
946 pp_lab = pprCLabel_asm clab
948 -- NEVER use commas within those string literals, cpp will ruin your day
949 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
950 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
951 ptext SLIT("4240"), char ',',
952 ptext SLIT("$26"), char ',',
953 ptext SLIT("0\n\t.prologue 1") ]
955 pprInstr (FUNEND clab)
956 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
959 Continue with Alpha-only printing bits and bobs:
963 pprRI (RIReg r) = pprReg r
964 pprRI (RIImm r) = pprImm r
966 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
967 pprRegRIReg name reg1 ri reg2
979 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
980 pprSizeRegRegReg name size reg1 reg2 reg3
993 #endif /* alpha_TARGET_ARCH */
996 %************************************************************************
998 \subsubsection{@pprInstr@ for an I386}
1000 %************************************************************************
1003 #if i386_TARGET_ARCH
1005 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1008 #if 0 /* #ifdef DEBUG */
1009 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1013 pprInstr (MOV size src dst)
1014 = pprSizeOpOp SLIT("mov") size src dst
1015 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
1016 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
1018 -- here we do some patching, since the physical registers are only set late
1019 -- in the code generation.
1020 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1022 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1023 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1025 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1026 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
1028 = pprInstr (ADD size (OpImm displ) dst)
1029 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1031 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1032 = pprSizeOp SLIT("dec") size dst
1033 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1034 = pprSizeOp SLIT("inc") size dst
1035 pprInstr (ADD size src dst)
1036 = pprSizeOpOp SLIT("add") size src dst
1037 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1038 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1040 {- A hack. The Intel documentation says that "The two and three
1041 operand forms [of IMUL] may also be used with unsigned operands
1042 because the lower half of the product is the same regardless if
1043 (sic) the operands are signed or unsigned. The CF and OF flags,
1044 however, cannot be used to determine if the upper half of the
1045 result is non-zero." So there.
1047 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1049 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1050 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1051 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1052 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1053 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1055 pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst
1056 pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst
1057 pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst
1058 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1060 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
1061 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1062 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1063 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1064 pprInstr PUSHA = ptext SLIT("\tpushal")
1065 pprInstr POPA = ptext SLIT("\tpopal")
1067 pprInstr NOP = ptext SLIT("\tnop")
1068 pprInstr CLTD = ptext SLIT("\tcltd")
1070 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
1072 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1074 pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1075 pprInstr (JMP dsts op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
1076 pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1077 pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg L reg)
1079 -- First bool indicates signedness; second whether quot or rem
1080 pprInstr (IQUOT sz src dst) = pprInstr_quotRem True True sz src dst
1081 pprInstr (IREM sz src dst) = pprInstr_quotRem True False sz src dst
1083 pprInstr (QUOT sz src dst) = pprInstr_quotRem False True sz src dst
1084 pprInstr (REM sz src dst) = pprInstr_quotRem False False sz src dst
1086 pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo
1089 -- Simulating a flat register set on the x86 FP stack is tricky.
1090 -- you have to free %st(7) before pushing anything on the FP reg stack
1091 -- so as to preclude the possibility of a FP stack overflow exception.
1092 pprInstr g@(GMOV src dst)
1096 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1098 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1099 pprInstr g@(GLD sz addr dst)
1100 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1101 pprAddr addr, gsemi, gpop dst 1])
1103 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1104 pprInstr g@(GST sz src addr)
1105 = pprG g (hcat [gtab, gpush src 0, gsemi,
1106 text "fstp", pprSize sz, gsp, pprAddr addr])
1108 pprInstr g@(GLDZ dst)
1109 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1110 pprInstr g@(GLD1 dst)
1111 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1113 pprInstr g@(GFTOI src dst)
1114 = pprInstr (GDTOI src dst)
1115 pprInstr g@(GDTOI src dst)
1116 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1117 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1120 pprInstr g@(GITOF src dst)
1121 = pprInstr (GITOD src dst)
1122 pprInstr g@(GITOD src dst)
1123 = pprG g (hcat [gtab, text "pushl ", pprReg L src,
1124 text " ; ffree %st(7); fildl (%esp) ; ",
1125 gpop dst 1, text " ; addl $4,%esp"])
1127 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1128 this far into the jungle AND you give a Rat's Ass (tm) what's going
1129 on, here's the deal. Generate code to do a floating point comparison
1130 of src1 and src2, of kind cond, and set the Zero flag if true.
1132 The complications are to do with handling NaNs correctly. We want the
1133 property that if either argument is NaN, then the result of the
1134 comparison is False ... except if we're comparing for inequality,
1135 in which case the answer is True.
1137 Here's how the general (non-inequality) case works. As an
1138 example, consider generating the an equality test:
1140 pushl %eax -- we need to mess with this
1141 <get src1 to top of FPU stack>
1142 fcomp <src2 location in FPU stack> and pop pushed src1
1143 -- Result of comparison is in FPU Status Register bits
1145 fstsw %ax -- Move FPU Status Reg to %ax
1146 sahf -- move C3 C2 C0 from %ax to integer flag reg
1147 -- now the serious magic begins
1148 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1149 sete %al -- %al = if arg1 == arg2 then 1 else 0
1150 andb %ah,%al -- %al &= %ah
1151 -- so %al == 1 iff (comparable && same); else it holds 0
1152 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1153 else %al == 0xFF, ZeroFlag=0
1154 -- the zero flag is now set as we desire.
1157 The special case of inequality differs thusly:
1159 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1160 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1161 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1162 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1163 else (%al == 0xFF, ZF=0)
1165 pprInstr g@(GCMP cond src1 src2)
1166 | case cond of { NE -> True; other -> False }
1168 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1169 hcat [gtab, text "fcomp ", greg src2 1,
1170 text "; fstsw %ax ; sahf ; setpe %ah"],
1171 hcat [gtab, text "setne %al ; ",
1172 text "orb %ah,%al ; decb %al ; popl %eax"]
1176 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1177 hcat [gtab, text "fcomp ", greg src2 1,
1178 text "; fstsw %ax ; sahf ; setpo %ah"],
1179 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1180 text "andb %ah,%al ; decb %al ; popl %eax"]
1183 {- On the 486, the flags set by FP compare are the unsigned ones!
1184 (This looks like a HACK to me. WDP 96/03)
1186 fix_FP_cond :: Cond -> Cond
1187 fix_FP_cond GE = GEU
1188 fix_FP_cond GTT = GU
1189 fix_FP_cond LTT = LU
1190 fix_FP_cond LE = LEU
1191 fix_FP_cond EQQ = EQQ
1193 -- there should be no others
1196 pprInstr g@(GABS sz src dst)
1197 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1198 pprInstr g@(GNEG sz src dst)
1199 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1201 pprInstr g@(GSQRT sz src dst)
1202 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1203 hcat [gtab, gcoerceto sz, gpop dst 1])
1204 pprInstr g@(GSIN sz src dst)
1205 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1206 hcat [gtab, gcoerceto sz, gpop dst 1])
1207 pprInstr g@(GCOS sz src dst)
1208 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1209 hcat [gtab, gcoerceto sz, gpop dst 1])
1210 pprInstr g@(GTAN sz src dst)
1211 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1212 gpush src 0, text " ; fptan ; ",
1213 text " fstp %st(0)"] $$
1214 hcat [gtab, gcoerceto sz, gpop dst 1])
1216 -- In the translations for GADD, GMUL, GSUB and GDIV,
1217 -- the first two cases are mere optimisations. The otherwise clause
1218 -- generates correct code under all circumstances.
1220 pprInstr g@(GADD sz src1 src2 dst)
1222 = pprG g (text "\t#GADD-xxxcase1" $$
1223 hcat [gtab, gpush src2 0,
1224 text " ; faddp %st(0),", greg src1 1])
1226 = pprG g (text "\t#GADD-xxxcase2" $$
1227 hcat [gtab, gpush src1 0,
1228 text " ; faddp %st(0),", greg src2 1])
1230 = pprG g (hcat [gtab, gpush src1 0,
1231 text " ; fadd ", greg src2 1, text ",%st(0)",
1235 pprInstr g@(GMUL sz src1 src2 dst)
1237 = pprG g (text "\t#GMUL-xxxcase1" $$
1238 hcat [gtab, gpush src2 0,
1239 text " ; fmulp %st(0),", greg src1 1])
1241 = pprG g (text "\t#GMUL-xxxcase2" $$
1242 hcat [gtab, gpush src1 0,
1243 text " ; fmulp %st(0),", greg src2 1])
1245 = pprG g (hcat [gtab, gpush src1 0,
1246 text " ; fmul ", greg src2 1, text ",%st(0)",
1250 pprInstr g@(GSUB sz src1 src2 dst)
1252 = pprG g (text "\t#GSUB-xxxcase1" $$
1253 hcat [gtab, gpush src2 0,
1254 text " ; fsubrp %st(0),", greg src1 1])
1256 = pprG g (text "\t#GSUB-xxxcase2" $$
1257 hcat [gtab, gpush src1 0,
1258 text " ; fsubp %st(0),", greg src2 1])
1260 = pprG g (hcat [gtab, gpush src1 0,
1261 text " ; fsub ", greg src2 1, text ",%st(0)",
1265 pprInstr g@(GDIV sz src1 src2 dst)
1267 = pprG g (text "\t#GDIV-xxxcase1" $$
1268 hcat [gtab, gpush src2 0,
1269 text " ; fdivrp %st(0),", greg src1 1])
1271 = pprG g (text "\t#GDIV-xxxcase2" $$
1272 hcat [gtab, gpush src1 0,
1273 text " ; fdivp %st(0),", greg src2 1])
1275 = pprG g (hcat [gtab, gpush src1 0,
1276 text " ; fdiv ", greg src2 1, text ",%st(0)",
1281 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1282 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1286 pprInstr_quotRem signed isQuot sz src dst
1287 | case sz of L -> False; _ -> True
1288 = panic "pprInstr_quotRem: dunno how to do non-32bit operands"
1291 (text "\t# BEGIN " <> fakeInsn),
1292 (text "\tpushl $0; pushl %eax; pushl %edx; pushl " <> pprOperand sz src),
1293 (text "\tmovl " <> pprOperand sz dst <> text ",%eax; " <> widen_to_64),
1294 (x86op <> text " 0(%esp); movl " <> text resReg <> text ",12(%esp)"),
1295 (text "\tpopl %edx; popl %edx; popl %eax; popl " <> pprOperand sz dst),
1296 (text "\t# END " <> fakeInsn)
1299 widen_to_64 | signed = text "cltd"
1300 | not signed = text "xorl %edx,%edx"
1301 x86op = if signed then text "\tidivl" else text "\tdivl"
1302 resReg = if isQuot then "%eax" else "%edx"
1303 opStr | signed = if isQuot then "IQUOT" else "IREM"
1304 | not signed = if isQuot then "QUOT" else "REM"
1305 fakeInsn = text opStr <+> pprOperand sz src
1306 <> char ',' <+> pprOperand sz dst
1308 -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg
1309 pprInstr_imul64 hi_reg lo_reg
1310 = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg
1311 pp_hi_reg = pprReg L hi_reg
1312 pp_lo_reg = pprReg L lo_reg
1315 text "\t# BEGIN " <> fakeInsn,
1316 text "\tpushl" <+> pp_hi_reg <> text" ; pushl" <+> pp_lo_reg,
1317 text "\tpushl %eax ; pushl %edx",
1318 text "\tmovl 12(%esp), %eax ; imull 8(%esp)",
1319 text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)",
1320 text "\tpopl %edx ; popl %eax",
1321 text "\tpopl" <+> pp_lo_reg <> text " ; popl" <+> pp_hi_reg,
1322 text "\t# END " <> fakeInsn
1326 --------------------------
1328 -- coerce %st(0) to the specified size
1329 gcoerceto DF = empty
1330 gcoerceto F = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1333 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1335 = hcat [text "fstp ", greg reg offset]
1337 bogus = text "\tbogus"
1338 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1343 gregno (RealReg i) = i
1344 gregno other = --pprPanic "gregno" (ppr other)
1345 999 -- bogus; only needed for debug printing
1347 pprG :: Instr -> Doc -> Doc
1349 = (char '#' <> pprGInstr fake) $$ actual
1351 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst
1352 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1353 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1355 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst
1356 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst
1358 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
1359 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1361 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
1362 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1364 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") DF co src dst
1365 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1366 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1367 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1368 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1369 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1370 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1372 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1373 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1374 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1375 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1378 Continue with I386-only printing bits and bobs:
1380 pprDollImm :: Imm -> Doc
1382 pprDollImm i = ptext SLIT("$") <> pprImm i
1384 pprOperand :: Size -> Operand -> Doc
1385 pprOperand s (OpReg r) = pprReg s r
1386 pprOperand s (OpImm i) = pprDollImm i
1387 pprOperand s (OpAddr ea) = pprAddr ea
1389 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
1390 pprSizeImmOp name size imm op1
1402 pprSizeOp :: LitString -> Size -> Operand -> Doc
1403 pprSizeOp name size op1
1412 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1413 pprSizeOpOp name size op1 op2
1419 pprOperand size op1,
1424 pprSizeByteOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1425 pprSizeByteOpOp name size op1 op2
1436 pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> Doc
1437 pprSizeOpReg name size op1 reg
1443 pprOperand size op1,
1448 pprSizeReg :: LitString -> Size -> Reg -> Doc
1449 pprSizeReg name size reg1
1458 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1459 pprSizeRegReg name size reg1 reg2
1470 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
1471 pprCondRegReg name size cond reg1 reg2
1482 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
1483 pprSizeSizeRegReg name size1 size2 reg1 reg2
1496 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1497 pprSizeRegRegReg name size reg1 reg2 reg3
1510 pprSizeAddr :: LitString -> Size -> MachRegsAddr -> Doc
1511 pprSizeAddr name size op
1520 pprSizeAddrReg :: LitString -> Size -> MachRegsAddr -> Reg -> Doc
1521 pprSizeAddrReg name size op dst
1532 pprSizeRegAddr :: LitString -> Size -> Reg -> MachRegsAddr -> Doc
1533 pprSizeRegAddr name size src op
1544 pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1545 pprOpOp name size op1 op2
1549 pprOperand size op1,
1554 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
1555 pprSizeOpOpCoerce name size1 size2 op1 op2
1556 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1557 pprOperand size1 op1,
1559 pprOperand size2 op2
1562 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1563 pprCondInstr name cond arg
1564 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1566 #endif /* i386_TARGET_ARCH */
1569 %************************************************************************
1571 \subsubsection{@pprInstr@ for a SPARC}
1573 %************************************************************************
1576 #if sparc_TARGET_ARCH
1578 -- a clumsy hack for now, to handle possible double alignment problems
1580 -- even clumsier, to allow for RegReg regs that show when doing indexed
1581 -- reads (bytearrays).
1584 -- Translate to the following:
1587 -- ld [g1+4],%f(n+1)
1588 -- sub g1,g2,g1 -- to restore g1
1589 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1591 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1592 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1593 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1594 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1599 -- ld [addr+4],%f(n+1)
1600 pprInstr (LD DF addr reg) | isJust off_addr
1602 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1603 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1606 off_addr = addrOffset addr 4
1607 addr2 = case off_addr of Just x -> x
1610 pprInstr (LD size addr reg)
1621 -- The same clumsy hack as above
1623 -- Translate to the following:
1626 -- st %f(n+1),[g1+4]
1627 -- sub g1,g2,g1 -- to restore g1
1628 pprInstr (ST DF reg (AddrRegReg g1 g2))
1630 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1631 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1633 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1634 pprReg g1, ptext SLIT("+4]")],
1635 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1640 -- st %f(n+1),[addr+4]
1641 pprInstr (ST DF reg addr) | isJust off_addr
1643 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1644 pprAddr addr, rbrack],
1645 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1646 pprAddr addr2, rbrack]
1649 off_addr = addrOffset addr 4
1650 addr2 = case off_addr of Just x -> x
1652 -- no distinction is made between signed and unsigned bytes on stores for the
1653 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1654 -- so we call a special-purpose pprSize for ST..
1656 pprInstr (ST size reg addr)
1667 pprInstr (ADD x cc reg1 ri reg2)
1668 | not x && not cc && riZero ri
1669 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1671 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1673 pprInstr (SUB x cc reg1 ri reg2)
1674 | not x && cc && reg2 == g0
1675 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1676 | not x && not cc && riZero ri
1677 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1679 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1681 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1682 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1684 pprInstr (OR b reg1 ri reg2)
1685 | not b && reg1 == g0
1686 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1688 RIReg rrr | rrr == reg2 -> empty
1691 = pprRegRIReg SLIT("or") b reg1 ri reg2
1693 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1695 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1696 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1698 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1699 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1700 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1702 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1703 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1704 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1706 pprInstr (SETHI imm reg)
1708 ptext SLIT("\tsethi\t"),
1714 pprInstr NOP = ptext SLIT("\tnop")
1716 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1717 pprInstr (FABS DF reg1 reg2)
1718 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1719 (if (reg1 == reg2) then empty
1720 else (<>) (char '\n')
1721 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1723 pprInstr (FADD size reg1 reg2 reg3)
1724 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1725 pprInstr (FCMP e size reg1 reg2)
1726 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1727 pprInstr (FDIV size reg1 reg2 reg3)
1728 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1730 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1731 pprInstr (FMOV DF reg1 reg2)
1732 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1733 (if (reg1 == reg2) then empty
1734 else (<>) (char '\n')
1735 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1737 pprInstr (FMUL size reg1 reg2 reg3)
1738 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1740 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1741 pprInstr (FNEG DF reg1 reg2)
1742 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1743 (if (reg1 == reg2) then empty
1744 else (<>) (char '\n')
1745 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1747 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1748 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1749 pprInstr (FxTOy size1 size2 reg1 reg2)
1762 pprReg reg1, comma, pprReg reg2
1766 pprInstr (BI cond b lab)
1768 ptext SLIT("\tb"), pprCond cond,
1769 if b then pp_comma_a else empty,
1774 pprInstr (BF cond b lab)
1776 ptext SLIT("\tfb"), pprCond cond,
1777 if b then pp_comma_a else empty,
1782 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1784 pprInstr (CALL (Left imm) n _)
1785 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1786 pprInstr (CALL (Right reg) n _)
1787 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1790 Continue with SPARC-only printing bits and bobs:
1793 pprRI (RIReg r) = pprReg r
1794 pprRI (RIImm r) = pprImm r
1796 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1797 pprSizeRegReg name size reg1 reg2
1802 F -> ptext SLIT("s\t")
1803 DF -> ptext SLIT("d\t")),
1809 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1810 pprSizeRegRegReg name size reg1 reg2 reg3
1815 F -> ptext SLIT("s\t")
1816 DF -> ptext SLIT("d\t")),
1824 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
1825 pprRegRIReg name b reg1 ri reg2
1829 if b then ptext SLIT("cc\t") else char '\t',
1837 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
1838 pprRIReg name b ri reg1
1842 if b then ptext SLIT("cc\t") else char '\t',
1848 pp_ld_lbracket = ptext SLIT("\tld\t[")
1849 pp_rbracket_comma = text "],"
1850 pp_comma_lbracket = text ",["
1851 pp_comma_a = text ",a"
1853 #endif /* sparc_TARGET_ARCH */
1856 %************************************************************************
1858 \subsubsection{@pprInstr@ for PowerPC}
1860 %************************************************************************
1863 #if powerpc_TARGET_ARCH
1864 pprInstr (LD sz reg addr) = hcat [
1880 pprInstr (ST sz reg addr) = hcat [
1889 pprInstr (STU sz reg addr) = hcat [
1898 pprInstr (LIS reg imm) = hcat [
1906 pprInstr (LI reg imm) = hcat [
1914 pprInstr (MR reg1 reg2)
1915 | reg1 == reg2 = empty
1916 | otherwise = hcat [
1918 case regClass reg1 of
1919 RcInteger -> ptext SLIT("mr")
1920 _ -> ptext SLIT("fmr"),
1926 pprInstr (CMP sz reg ri) = hcat [
1942 pprInstr (CMPL sz reg ri) = hcat [
1958 pprInstr (BCC cond lbl) = hcat [
1966 pprInstr (MTCTR reg) = hcat [
1968 ptext SLIT("mtctr"),
1972 pprInstr (BCTR _) = hcat [
1976 pprInstr (BL imm _) = hcat [
1982 pprInstr (BCTRL _) = hcat [
1986 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
1987 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
1988 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
1989 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
1990 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
1991 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
1993 -- for some reason, "andi" doesn't exist.
1994 -- we'll use "andi." instead.
1995 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
1997 ptext SLIT("andi."),
2005 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 (toUI16 ri)
2007 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 (toUI16 ri)
2008 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 (toUI16 ri)
2010 pprInstr (XORIS reg1 reg2 imm) = hcat [
2012 ptext SLIT("xoris"),
2021 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 ri
2022 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 ri
2023 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 ri
2024 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2025 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2027 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2028 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2029 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2030 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2031 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2033 pprInstr (FCMP reg1 reg2) = hcat [
2035 ptext SLIT("fcmpu\tcr0, "),
2036 -- Note: we're using fcmpu, not fcmpo
2037 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2038 -- We don't handle invalid fp ops, so we don't care
2044 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2046 pprInstr _ = ptext SLIT("something")
2048 pprLogic op reg1 reg2 ri = hcat [
2053 RIImm _ -> char 'i',
2062 pprUnary op reg1 reg2 = hcat [
2071 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2084 pprRI (RIReg r) = pprReg r
2085 pprRI (RIImm r) = pprImm r
2088 pprFSize F = char 's'
2090 -- hack to ensure that negative vals come out in non-negative form
2091 -- (assuming that fromIntegral{Int->Word16} will do a 'c-style'
2092 -- conversion, and not throw a fit/exception.)
2094 toUI16 (RIImm (ImmInt x))
2095 | x < 0 = RIImm (ImmInt (fromIntegral ((fromIntegral x) :: Word16)))
2096 toUI16 (RIImm (ImmInteger x))
2097 | x < 0 = RIImm (ImmInt (fromIntegral ((fromIntegral x) :: Word16)))
2101 The Mach-O object file format used in Darwin/Mac OS X needs a so-called
2102 "symbol stub" for every function that might be imported from a dynamic
2104 The stubs are always the same, and they are all output at the end of the
2105 generated assembly (see AsmCodeGen.lhs), so we don't use the Instr datatype.
2106 Instead, we just pretty-print it directly.
2109 #if darwin_TARGET_OS
2110 pprDyldSymbolStub fn =
2112 ptext SLIT(".symbol_stub"),
2113 ptext SLIT("L_") <> ftext fn <> ptext SLIT("$stub:"),
2114 ptext SLIT("\t.indirect_symbol _") <> ftext fn,
2115 ptext SLIT("\tlis r11,ha16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
2116 ptext SLIT("\tlwz r12,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)(r11)"),
2117 ptext SLIT("\tmtctr r12"),
2118 ptext SLIT("\taddi r11,r11,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
2119 ptext SLIT("\tbctr"),
2120 ptext SLIT(".lazy_symbol_pointer"),
2121 ptext SLIT("L_") <> ftext fn <> ptext SLIT("$lazy_ptr:"),
2122 ptext SLIT("\t.indirect_symbol _") <> ftext fn,
2123 ptext SLIT("\t.long dyld_stub_binding_helper")
2128 #endif /* powerpc_TARGET_ARCH */
2132 #if __GLASGOW_HASKELL__ >= 504
2133 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
2134 newFloatArray = newArray_
2136 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
2137 newDoubleArray = newArray_
2139 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2140 castFloatToCharArray = castSTUArray
2142 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2143 castDoubleToCharArray = castSTUArray
2145 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
2146 writeFloatArray = writeArray
2148 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
2149 writeDoubleArray = writeArray
2151 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
2152 readCharArray arr i = do
2153 w <- readArray arr i
2154 return $! (chr (fromIntegral w))
2158 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2159 castFloatToCharArray = return
2161 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2164 castDoubleToCharArray = return
2168 -- floatToBytes and doubleToBytes convert to the host's byte
2169 -- order. Providing that we're not cross-compiling for a
2170 -- target with the opposite endianness, this should work ok
2173 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2174 -- could they be merged?
2176 floatToBytes :: Float -> [Int]
2179 arr <- newFloatArray ((0::Int),3)
2180 writeFloatArray arr 0 f
2181 arr <- castFloatToCharArray arr
2182 i0 <- readCharArray arr 0
2183 i1 <- readCharArray arr 1
2184 i2 <- readCharArray arr 2
2185 i3 <- readCharArray arr 3
2186 return (map ord [i0,i1,i2,i3])
2189 doubleToBytes :: Double -> [Int]
2192 arr <- newDoubleArray ((0::Int),7)
2193 writeDoubleArray arr 0 d
2194 arr <- castDoubleToCharArray arr
2195 i0 <- readCharArray arr 0
2196 i1 <- readCharArray arr 1
2197 i2 <- readCharArray arr 2
2198 i3 <- readCharArray arr 3
2199 i4 <- readCharArray arr 4
2200 i5 <- readCharArray arr 5
2201 i6 <- readCharArray arr 6
2202 i7 <- readCharArray arr 7
2203 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])