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 )
36 import Char ( chr, ord )
37 import Maybe ( isJust )
39 asmSDoc d = Outputable.withPprStyleDoc (
40 Outputable.mkCodeStyle Outputable.AsmStyle) d
41 pprCLabel_asm l = asmSDoc (pprCLabel l)
44 %************************************************************************
46 \subsection{@pprReg@: print a @Reg@}
48 %************************************************************************
50 For x86, the way we print a register name depends
51 on which bit of it we care about. Yurgh.
53 pprUserReg :: Reg -> Doc
54 pprUserReg = pprReg IF_ARCH_i386(L,)
56 pprReg :: IF_ARCH_i386(Size ->,) Reg -> Doc
58 pprReg IF_ARCH_i386(s,) r
60 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) i
61 VirtualRegI u -> text "%vI_" <> asmSDoc (pprVRegUnique u)
62 VirtualRegF u -> text "%vF_" <> asmSDoc (pprVRegUnique u)
65 ppr_reg_no :: Int -> Doc
68 0 -> SLIT("$0"); 1 -> SLIT("$1");
69 2 -> SLIT("$2"); 3 -> SLIT("$3");
70 4 -> SLIT("$4"); 5 -> SLIT("$5");
71 6 -> SLIT("$6"); 7 -> SLIT("$7");
72 8 -> SLIT("$8"); 9 -> SLIT("$9");
73 10 -> SLIT("$10"); 11 -> SLIT("$11");
74 12 -> SLIT("$12"); 13 -> SLIT("$13");
75 14 -> SLIT("$14"); 15 -> SLIT("$15");
76 16 -> SLIT("$16"); 17 -> SLIT("$17");
77 18 -> SLIT("$18"); 19 -> SLIT("$19");
78 20 -> SLIT("$20"); 21 -> SLIT("$21");
79 22 -> SLIT("$22"); 23 -> SLIT("$23");
80 24 -> SLIT("$24"); 25 -> SLIT("$25");
81 26 -> SLIT("$26"); 27 -> SLIT("$27");
82 28 -> SLIT("$28"); 29 -> SLIT("$29");
83 30 -> SLIT("$30"); 31 -> SLIT("$31");
84 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
85 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
86 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
87 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
88 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
89 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
90 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
91 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
92 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
93 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
94 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
95 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
96 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
97 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
98 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
99 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
100 _ -> SLIT("very naughty alpha register")
104 ppr_reg_no :: Size -> Int -> Doc
105 ppr_reg_no B = ppr_reg_byte
106 ppr_reg_no Bu = ppr_reg_byte
107 ppr_reg_no W = ppr_reg_word
108 ppr_reg_no Wu = ppr_reg_word
109 ppr_reg_no _ = ppr_reg_long
111 ppr_reg_byte i = ptext
113 0 -> SLIT("%al"); 1 -> SLIT("%bl");
114 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
115 _ -> SLIT("very naughty I386 byte register")
118 ppr_reg_word i = ptext
120 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
121 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
122 4 -> SLIT("%si"); 5 -> SLIT("%di");
123 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
124 _ -> SLIT("very naughty I386 word register")
127 ppr_reg_long i = ptext
129 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
130 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
131 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
132 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
133 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
134 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
135 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
136 _ -> SLIT("very naughty I386 register")
139 #if sparc_TARGET_ARCH
140 ppr_reg_no :: Int -> Doc
143 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
144 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
145 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
146 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
147 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
148 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
149 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
150 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
151 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
152 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
153 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
154 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
155 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
156 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
157 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
158 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
159 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
160 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
161 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
162 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
163 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
164 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
165 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
166 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
167 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
168 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
169 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
170 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
171 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
172 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
173 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
174 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
175 _ -> SLIT("very naughty sparc register")
178 #if powerpc_TARGET_ARCH
179 ppr_reg_no :: Int -> Doc
182 0 -> SLIT("r0"); 1 -> SLIT("r1");
183 2 -> SLIT("r2"); 3 -> SLIT("r3");
184 4 -> SLIT("r4"); 5 -> SLIT("r5");
185 6 -> SLIT("r6"); 7 -> SLIT("r7");
186 8 -> SLIT("r8"); 9 -> SLIT("r9");
187 10 -> SLIT("r10"); 11 -> SLIT("r11");
188 12 -> SLIT("r12"); 13 -> SLIT("r13");
189 14 -> SLIT("r14"); 15 -> SLIT("r15");
190 16 -> SLIT("r16"); 17 -> SLIT("r17");
191 18 -> SLIT("r18"); 19 -> SLIT("r19");
192 20 -> SLIT("r20"); 21 -> SLIT("r21");
193 22 -> SLIT("r22"); 23 -> SLIT("r23");
194 24 -> SLIT("r24"); 25 -> SLIT("r25");
195 26 -> SLIT("r26"); 27 -> SLIT("r27");
196 28 -> SLIT("r28"); 29 -> SLIT("r29");
197 30 -> SLIT("r30"); 31 -> SLIT("r31");
198 32 -> SLIT("f0"); 33 -> SLIT("f1");
199 34 -> SLIT("f2"); 35 -> SLIT("f3");
200 36 -> SLIT("f4"); 37 -> SLIT("f5");
201 38 -> SLIT("f6"); 39 -> SLIT("f7");
202 40 -> SLIT("f8"); 41 -> SLIT("f9");
203 42 -> SLIT("f10"); 43 -> SLIT("f11");
204 44 -> SLIT("f12"); 45 -> SLIT("f13");
205 46 -> SLIT("f14"); 47 -> SLIT("f15");
206 48 -> SLIT("f16"); 49 -> SLIT("f17");
207 50 -> SLIT("f18"); 51 -> SLIT("f19");
208 52 -> SLIT("f20"); 53 -> SLIT("f21");
209 54 -> SLIT("f22"); 55 -> SLIT("f23");
210 56 -> SLIT("f24"); 57 -> SLIT("f25");
211 58 -> SLIT("f26"); 59 -> SLIT("f27");
212 60 -> SLIT("f28"); 61 -> SLIT("f29");
213 62 -> SLIT("f30"); 63 -> SLIT("f31");
214 _ -> SLIT("very naughty powerpc register")
219 %************************************************************************
221 \subsection{@pprSize@: print a @Size@}
223 %************************************************************************
226 pprSize :: Size -> Doc
228 pprSize x = ptext (case x of
229 #if alpha_TARGET_ARCH
232 -- W -> SLIT("w") UNUSED
233 -- Wu -> SLIT("wu") UNUSED
236 -- FF -> SLIT("f") UNUSED
237 -- DF -> SLIT("d") UNUSED
238 -- GF -> SLIT("g") UNUSED
239 -- SF -> SLIT("s") UNUSED
253 #if sparc_TARGET_ARCH
262 pprStSize :: Size -> Doc
263 pprStSize x = ptext (case x of
272 #if powerpc_TARGET_ARCH
284 %************************************************************************
286 \subsection{@pprCond@: print a @Cond@}
288 %************************************************************************
291 pprCond :: Cond -> Doc
293 pprCond c = ptext (case c of {
294 #if alpha_TARGET_ARCH
305 GEU -> SLIT("ae"); LU -> SLIT("b");
306 EQQ -> SLIT("e"); GTT -> SLIT("g");
307 GE -> SLIT("ge"); GU -> SLIT("a");
308 LTT -> SLIT("l"); LE -> SLIT("le");
309 LEU -> SLIT("be"); NE -> SLIT("ne");
310 NEG -> SLIT("s"); POS -> SLIT("ns");
311 CARRY -> SLIT("c"); OFLO -> SLIT("o");
312 ALWAYS -> SLIT("mp") -- hack
314 #if sparc_TARGET_ARCH
315 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
316 GEU -> SLIT("geu"); LU -> SLIT("lu");
317 EQQ -> SLIT("e"); GTT -> SLIT("g");
318 GE -> SLIT("ge"); GU -> SLIT("gu");
319 LTT -> SLIT("l"); LE -> SLIT("le");
320 LEU -> SLIT("leu"); NE -> SLIT("ne");
321 NEG -> SLIT("neg"); POS -> SLIT("pos");
322 VC -> SLIT("vc"); VS -> SLIT("vs")
324 #if powerpc_TARGET_ARCH
326 EQQ -> SLIT("eq"); NE -> SLIT("ne");
327 LTT -> SLIT("lt"); GE -> SLIT("ge");
328 GTT -> SLIT("gt"); LE -> SLIT("le");
329 LU -> SLIT("lt"); GEU -> SLIT("ge");
330 GU -> SLIT("gt"); LEU -> SLIT("le");
335 %************************************************************************
337 \subsection{@pprImm@: print an @Imm@}
339 %************************************************************************
344 pprImm (ImmInt i) = int i
345 pprImm (ImmInteger i) = integer i
346 pprImm (ImmCLbl l) = (if labelDynamic l then text "__imp_" else empty)
348 pprImm (ImmIndex l i) = (if labelDynamic l then text "__imp_" else empty)
349 <> pprCLabel_asm l <> char '+' <> int i
350 pprImm (ImmLit s) = s
352 pprImm (ImmLab dll s) = (if underscorePrefix then char '_' else empty)
353 <> (if dll then text "_imp__" else empty)
356 #if sparc_TARGET_ARCH
358 = hcat [ pp_lo, pprImm i, rparen ]
363 = hcat [ pp_hi, pprImm i, rparen ]
367 #if powerpc_TARGET_ARCH
369 = hcat [ pp_lo, pprImm i, rparen ]
374 = hcat [ pp_hi, pprImm i, rparen ]
379 = hcat [ pp_ha, pprImm i, rparen ]
385 %************************************************************************
387 \subsection{@pprAddr@: print an @Addr@}
389 %************************************************************************
392 pprAddr :: MachRegsAddr -> Doc
394 #if alpha_TARGET_ARCH
395 pprAddr (AddrReg r) = parens (pprReg r)
396 pprAddr (AddrImm i) = pprImm i
397 pprAddr (AddrRegImm r1 i)
398 = (<>) (pprImm i) (parens (pprReg r1))
404 pprAddr (ImmAddr imm off)
405 = let pp_imm = pprImm imm
409 else if (off < 0) then
412 pp_imm <> char '+' <> int off
414 pprAddr (AddrBaseIndex base index displacement)
416 pp_disp = ppr_disp displacement
417 pp_off p = pp_disp <> char '(' <> p <> char ')'
418 pp_reg r = pprReg L r
421 (Nothing, Nothing) -> pp_disp
422 (Just b, Nothing) -> pp_off (pp_reg b)
423 (Nothing, Just (r,i)) -> pp_off (pp_reg r <> comma <> int i)
424 (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
427 ppr_disp (ImmInt 0) = empty
428 ppr_disp imm = pprImm imm
433 #if sparc_TARGET_ARCH
434 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
436 pprAddr (AddrRegReg r1 r2)
437 = hcat [ pprReg r1, char '+', pprReg r2 ]
439 pprAddr (AddrRegImm r1 (ImmInt i))
441 | not (fits13Bits i) = largeOffsetError i
442 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
444 pp_sign = if i > 0 then char '+' else empty
446 pprAddr (AddrRegImm r1 (ImmInteger i))
448 | not (fits13Bits i) = largeOffsetError i
451 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
453 pp_sign = if i > 0 then char '+' else empty
455 pprAddr (AddrRegImm r1 imm)
456 = hcat [ pprReg r1, char '+', pprImm imm ]
458 #if powerpc_TARGET_ARCH
459 pprAddr (AddrRegReg r1 r2)
460 = error "PprMach.pprAddr (AddrRegReg) unimplemented"
462 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
463 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
464 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
468 %************************************************************************
470 \subsection{@pprInstr@: print an @Instr@}
472 %************************************************************************
475 pprInstr :: Instr -> Doc
477 --pprInstr (COMMENT s) = empty -- nuke 'em
479 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
480 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
481 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
482 ,IF_ARCH_powerpc( ((<>) (ptext SLIT("; ")) (ftext s))
486 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
488 pprInstr (SEGMENT TextSegment)
489 = IF_ARCH_alpha(ptext SLIT("\t.text\n\t.align 3") {-word boundary-}
490 ,IF_ARCH_sparc(ptext SLIT(".text\n\t.align 4") {-word boundary-}
491 ,IF_ARCH_i386((text ".text\n\t.align 4,0x90") {-needs per-OS variation!-}
492 ,IF_ARCH_powerpc(ptext SLIT(".text\n.align 2")
495 pprInstr (SEGMENT DataSegment)
497 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
498 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
499 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
500 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
503 pprInstr (SEGMENT RoDataSegment)
505 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
506 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
507 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
508 ,IF_ARCH_powerpc(SLIT(".const_data\n.align 2")
511 pprInstr (LABEL clab)
513 pp_lab = pprCLabel_asm clab
516 if not (externallyVisibleCLabel clab) then
520 IF_ARCH_alpha(SLIT("\t.globl\t")
521 ,IF_ARCH_i386(SLIT(".globl ")
522 ,IF_ARCH_sparc(SLIT(".global\t")
523 ,IF_ARCH_powerpc(SLIT(".globl ")
525 , pp_lab, char '\n'],
530 pprInstr (ASCII False{-no backslash conversion-} str)
531 = hcat [ ptext SLIT("\t.asciz "), char '\"', text str, char '"' ]
533 pprInstr (ASCII True str)
534 = vcat (map do1 (str ++ [chr 0]))
537 do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
540 hshow n | n >= 0 && n <= 255
541 = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
542 tab = "0123456789ABCDEF"
546 = vcat (concatMap (ppr_item s) xs)
549 #if alpha_TARGET_ARCH
550 ppr_item = error "ppr_item on Alpha"
552 #if sparc_TARGET_ARCH
553 -- copy n paste of x86 version
554 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
555 ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x]
556 ppr_item F (ImmFloat r)
557 = let bs = floatToBytes (fromRational r)
558 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
559 ppr_item DF (ImmDouble r)
560 = let bs = doubleToBytes (fromRational r)
561 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
564 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
565 ppr_item L x = [ptext SLIT("\t.long\t") <> pprImm x]
566 ppr_item F (ImmFloat r)
567 = let bs = floatToBytes (fromRational r)
568 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
569 ppr_item DF (ImmDouble r)
570 = let bs = doubleToBytes (fromRational r)
571 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
573 #if powerpc_TARGET_ARCH
574 ppr_item B x = [ptext SLIT("\t.byte\t") <> pprImm x]
575 ppr_item Bu x = [ptext SLIT("\t.byte\t") <> pprImm x]
576 ppr_item H x = [ptext SLIT("\t.byte\t") <> pprImm x]
577 ppr_item Hu x = [ptext SLIT("\t.byte\t") <> pprImm x]
578 ppr_item W x = [ptext SLIT("\t.long\t") <> pprImm x]
579 ppr_item F (ImmFloat r)
580 = let bs = floatToBytes (fromRational r)
581 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
582 ppr_item DF (ImmDouble r)
583 = let bs = doubleToBytes (fromRational r)
584 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
587 -- fall through to rest of (machine-specific) pprInstr...
590 %************************************************************************
592 \subsubsection{@pprInstr@ for an Alpha}
594 %************************************************************************
597 #if alpha_TARGET_ARCH
599 pprInstr (LD size reg addr)
609 pprInstr (LDA reg addr)
611 ptext SLIT("\tlda\t"),
617 pprInstr (LDAH reg addr)
619 ptext SLIT("\tldah\t"),
625 pprInstr (LDGP reg addr)
627 ptext SLIT("\tldgp\t"),
633 pprInstr (LDI size reg imm)
643 pprInstr (ST size reg addr)
655 ptext SLIT("\tclr\t"),
659 pprInstr (ABS size ri reg)
669 pprInstr (NEG size ov ri reg)
673 if ov then ptext SLIT("v\t") else char '\t',
679 pprInstr (ADD size ov reg1 ri reg2)
683 if ov then ptext SLIT("v\t") else char '\t',
691 pprInstr (SADD size scale reg1 ri reg2)
693 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
704 pprInstr (SUB size ov reg1 ri reg2)
708 if ov then ptext SLIT("v\t") else char '\t',
716 pprInstr (SSUB size scale reg1 ri reg2)
718 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
729 pprInstr (MUL size ov reg1 ri reg2)
733 if ov then ptext SLIT("v\t") else char '\t',
741 pprInstr (DIV size uns reg1 ri reg2)
745 if uns then ptext SLIT("u\t") else char '\t',
753 pprInstr (REM size uns reg1 ri reg2)
757 if uns then ptext SLIT("u\t") else char '\t',
765 pprInstr (NOT ri reg)
774 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
775 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
776 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
777 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
778 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
779 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
781 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
782 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
783 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
785 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
786 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
788 pprInstr (NOP) = ptext SLIT("\tnop")
790 pprInstr (CMP cond reg1 ri reg2)
804 ptext SLIT("\tfclr\t"),
808 pprInstr (FABS reg1 reg2)
810 ptext SLIT("\tfabs\t"),
816 pprInstr (FNEG size reg1 reg2)
826 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
827 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
828 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
829 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
831 pprInstr (CVTxy size1 size2 reg1 reg2)
835 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
842 pprInstr (FCMP size cond reg1 reg2 reg3)
855 pprInstr (FMOV reg1 reg2)
857 ptext SLIT("\tfmov\t"),
863 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
865 pprInstr (BI NEVER reg lab) = empty
867 pprInstr (BI cond reg lab)
877 pprInstr (BF cond reg lab)
888 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
890 pprInstr (JMP reg addr hint)
892 ptext SLIT("\tjmp\t"),
901 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
903 pprInstr (JSR reg addr n)
905 ptext SLIT("\tjsr\t"),
911 pprInstr (FUNBEGIN clab)
913 if (externallyVisibleCLabel clab) then
914 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
917 ptext SLIT("\t.ent "),
926 pp_lab = pprCLabel_asm clab
928 -- NEVER use commas within those string literals, cpp will ruin your day
929 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
930 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
931 ptext SLIT("4240"), char ',',
932 ptext SLIT("$26"), char ',',
933 ptext SLIT("0\n\t.prologue 1") ]
935 pprInstr (FUNEND clab)
936 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
939 Continue with Alpha-only printing bits and bobs:
943 pprRI (RIReg r) = pprReg r
944 pprRI (RIImm r) = pprImm r
946 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
947 pprRegRIReg name reg1 ri reg2
959 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
960 pprSizeRegRegReg name size reg1 reg2 reg3
973 #endif /* alpha_TARGET_ARCH */
976 %************************************************************************
978 \subsubsection{@pprInstr@ for an I386}
980 %************************************************************************
985 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
988 #if 0 /* #ifdef DEBUG */
989 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
993 pprInstr (MOV size src dst)
994 = pprSizeOpOp SLIT("mov") size src dst
995 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes L src dst
996 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes L src dst
998 -- here we do some patching, since the physical registers are only set late
999 -- in the code generation.
1000 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1002 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1003 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1005 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1006 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
1008 = pprInstr (ADD size (OpImm displ) dst)
1009 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1011 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1012 = pprSizeOp SLIT("dec") size dst
1013 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1014 = pprSizeOp SLIT("inc") size dst
1015 pprInstr (ADD size src dst)
1016 = pprSizeOpOp SLIT("add") size src dst
1017 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1018 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1020 {- A hack. The Intel documentation says that "The two and three
1021 operand forms [of IMUL] may also be used with unsigned operands
1022 because the lower half of the product is the same regardless if
1023 (sic) the operands are signed or unsigned. The CF and OF flags,
1024 however, cannot be used to determine if the upper half of the
1025 result is non-zero." So there.
1027 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1029 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1030 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1031 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1032 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1033 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1035 pprInstr (SHL size imm dst) = pprSizeImmOp SLIT("shl") size imm dst
1036 pprInstr (SAR size imm dst) = pprSizeImmOp SLIT("sar") size imm dst
1037 pprInstr (SHR size imm dst) = pprSizeImmOp SLIT("shr") size imm dst
1038 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1040 pprInstr (CMP size src dst) = pprSizeOpOp SLIT("cmp") size src dst
1041 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1042 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1043 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1044 pprInstr PUSHA = ptext SLIT("\tpushal")
1045 pprInstr POPA = ptext SLIT("\tpopal")
1047 pprInstr NOP = ptext SLIT("\tnop")
1048 pprInstr CLTD = ptext SLIT("\tcltd")
1050 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand B op)
1052 pprInstr (JXX cond lab) = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1054 pprInstr (JMP dsts (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1055 pprInstr (JMP dsts op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand L op)
1056 pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1057 pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg L reg)
1059 -- First bool indicates signedness; second whether quot or rem
1060 pprInstr (IQUOT sz src dst) = pprInstr_quotRem True True sz src dst
1061 pprInstr (IREM sz src dst) = pprInstr_quotRem True False sz src dst
1063 pprInstr (QUOT sz src dst) = pprInstr_quotRem False True sz src dst
1064 pprInstr (REM sz src dst) = pprInstr_quotRem False False sz src dst
1066 pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo
1069 -- Simulating a flat register set on the x86 FP stack is tricky.
1070 -- you have to free %st(7) before pushing anything on the FP reg stack
1071 -- so as to preclude the possibility of a FP stack overflow exception.
1072 pprInstr g@(GMOV src dst)
1076 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1078 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1079 pprInstr g@(GLD sz addr dst)
1080 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1081 pprAddr addr, gsemi, gpop dst 1])
1083 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1084 pprInstr g@(GST sz src addr)
1085 = pprG g (hcat [gtab, gpush src 0, gsemi,
1086 text "fstp", pprSize sz, gsp, pprAddr addr])
1088 pprInstr g@(GLDZ dst)
1089 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1090 pprInstr g@(GLD1 dst)
1091 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1093 pprInstr g@(GFTOI src dst)
1094 = pprInstr (GDTOI src dst)
1095 pprInstr g@(GDTOI src dst)
1096 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1097 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1100 pprInstr g@(GITOF src dst)
1101 = pprInstr (GITOD src dst)
1102 pprInstr g@(GITOD src dst)
1103 = pprG g (hcat [gtab, text "pushl ", pprReg L src,
1104 text " ; ffree %st(7); fildl (%esp) ; ",
1105 gpop dst 1, text " ; addl $4,%esp"])
1107 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1108 this far into the jungle AND you give a Rat's Ass (tm) what's going
1109 on, here's the deal. Generate code to do a floating point comparison
1110 of src1 and src2, of kind cond, and set the Zero flag if true.
1112 The complications are to do with handling NaNs correctly. We want the
1113 property that if either argument is NaN, then the result of the
1114 comparison is False ... except if we're comparing for inequality,
1115 in which case the answer is True.
1117 Here's how the general (non-inequality) case works. As an
1118 example, consider generating the an equality test:
1120 pushl %eax -- we need to mess with this
1121 <get src1 to top of FPU stack>
1122 fcomp <src2 location in FPU stack> and pop pushed src1
1123 -- Result of comparison is in FPU Status Register bits
1125 fstsw %ax -- Move FPU Status Reg to %ax
1126 sahf -- move C3 C2 C0 from %ax to integer flag reg
1127 -- now the serious magic begins
1128 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1129 sete %al -- %al = if arg1 == arg2 then 1 else 0
1130 andb %ah,%al -- %al &= %ah
1131 -- so %al == 1 iff (comparable && same); else it holds 0
1132 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1133 else %al == 0xFF, ZeroFlag=0
1134 -- the zero flag is now set as we desire.
1137 The special case of inequality differs thusly:
1139 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1140 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1141 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1142 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1143 else (%al == 0xFF, ZF=0)
1145 pprInstr g@(GCMP cond src1 src2)
1146 | case cond of { NE -> True; other -> False }
1148 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1149 hcat [gtab, text "fcomp ", greg src2 1,
1150 text "; fstsw %ax ; sahf ; setpe %ah"],
1151 hcat [gtab, text "setne %al ; ",
1152 text "orb %ah,%al ; decb %al ; popl %eax"]
1156 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1157 hcat [gtab, text "fcomp ", greg src2 1,
1158 text "; fstsw %ax ; sahf ; setpo %ah"],
1159 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1160 text "andb %ah,%al ; decb %al ; popl %eax"]
1163 {- On the 486, the flags set by FP compare are the unsigned ones!
1164 (This looks like a HACK to me. WDP 96/03)
1166 fix_FP_cond :: Cond -> Cond
1167 fix_FP_cond GE = GEU
1168 fix_FP_cond GTT = GU
1169 fix_FP_cond LTT = LU
1170 fix_FP_cond LE = LEU
1171 fix_FP_cond EQQ = EQQ
1173 -- there should be no others
1176 pprInstr g@(GABS sz src dst)
1177 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1178 pprInstr g@(GNEG sz src dst)
1179 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1181 pprInstr g@(GSQRT sz src dst)
1182 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1183 hcat [gtab, gcoerceto sz, gpop dst 1])
1184 pprInstr g@(GSIN sz src dst)
1185 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1186 hcat [gtab, gcoerceto sz, gpop dst 1])
1187 pprInstr g@(GCOS sz src dst)
1188 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1189 hcat [gtab, gcoerceto sz, gpop dst 1])
1190 pprInstr g@(GTAN sz src dst)
1191 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1192 gpush src 0, text " ; fptan ; ",
1193 text " fstp %st(0)"] $$
1194 hcat [gtab, gcoerceto sz, gpop dst 1])
1196 -- In the translations for GADD, GMUL, GSUB and GDIV,
1197 -- the first two cases are mere optimisations. The otherwise clause
1198 -- generates correct code under all circumstances.
1200 pprInstr g@(GADD sz src1 src2 dst)
1202 = pprG g (text "\t#GADD-xxxcase1" $$
1203 hcat [gtab, gpush src2 0,
1204 text " ; faddp %st(0),", greg src1 1])
1206 = pprG g (text "\t#GADD-xxxcase2" $$
1207 hcat [gtab, gpush src1 0,
1208 text " ; faddp %st(0),", greg src2 1])
1210 = pprG g (hcat [gtab, gpush src1 0,
1211 text " ; fadd ", greg src2 1, text ",%st(0)",
1215 pprInstr g@(GMUL sz src1 src2 dst)
1217 = pprG g (text "\t#GMUL-xxxcase1" $$
1218 hcat [gtab, gpush src2 0,
1219 text " ; fmulp %st(0),", greg src1 1])
1221 = pprG g (text "\t#GMUL-xxxcase2" $$
1222 hcat [gtab, gpush src1 0,
1223 text " ; fmulp %st(0),", greg src2 1])
1225 = pprG g (hcat [gtab, gpush src1 0,
1226 text " ; fmul ", greg src2 1, text ",%st(0)",
1230 pprInstr g@(GSUB sz src1 src2 dst)
1232 = pprG g (text "\t#GSUB-xxxcase1" $$
1233 hcat [gtab, gpush src2 0,
1234 text " ; fsubrp %st(0),", greg src1 1])
1236 = pprG g (text "\t#GSUB-xxxcase2" $$
1237 hcat [gtab, gpush src1 0,
1238 text " ; fsubp %st(0),", greg src2 1])
1240 = pprG g (hcat [gtab, gpush src1 0,
1241 text " ; fsub ", greg src2 1, text ",%st(0)",
1245 pprInstr g@(GDIV sz src1 src2 dst)
1247 = pprG g (text "\t#GDIV-xxxcase1" $$
1248 hcat [gtab, gpush src2 0,
1249 text " ; fdivrp %st(0),", greg src1 1])
1251 = pprG g (text "\t#GDIV-xxxcase2" $$
1252 hcat [gtab, gpush src1 0,
1253 text " ; fdivp %st(0),", greg src2 1])
1255 = pprG g (hcat [gtab, gpush src1 0,
1256 text " ; fdiv ", greg src2 1, text ",%st(0)",
1261 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1262 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1266 pprInstr_quotRem signed isQuot sz src dst
1267 | case sz of L -> False; _ -> True
1268 = panic "pprInstr_quotRem: dunno how to do non-32bit operands"
1271 (text "\t# BEGIN " <> fakeInsn),
1272 (text "\tpushl $0; pushl %eax; pushl %edx; pushl " <> pprOperand sz src),
1273 (text "\tmovl " <> pprOperand sz dst <> text ",%eax; " <> widen_to_64),
1274 (x86op <> text " 0(%esp); movl " <> text resReg <> text ",12(%esp)"),
1275 (text "\tpopl %edx; popl %edx; popl %eax; popl " <> pprOperand sz dst),
1276 (text "\t# END " <> fakeInsn)
1279 widen_to_64 | signed = text "cltd"
1280 | not signed = text "xorl %edx,%edx"
1281 x86op = if signed then text "\tidivl" else text "\tdivl"
1282 resReg = if isQuot then "%eax" else "%edx"
1283 opStr | signed = if isQuot then "IQUOT" else "IREM"
1284 | not signed = if isQuot then "QUOT" else "REM"
1285 fakeInsn = text opStr <+> pprOperand sz src
1286 <> char ',' <+> pprOperand sz dst
1288 -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg
1289 pprInstr_imul64 hi_reg lo_reg
1290 = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg
1291 pp_hi_reg = pprReg L hi_reg
1292 pp_lo_reg = pprReg L lo_reg
1295 text "\t# BEGIN " <> fakeInsn,
1296 text "\tpushl" <+> pp_hi_reg <> text" ; pushl" <+> pp_lo_reg,
1297 text "\tpushl %eax ; pushl %edx",
1298 text "\tmovl 12(%esp), %eax ; imull 8(%esp)",
1299 text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)",
1300 text "\tpopl %edx ; popl %eax",
1301 text "\tpopl" <+> pp_lo_reg <> text " ; popl" <+> pp_hi_reg,
1302 text "\t# END " <> fakeInsn
1306 --------------------------
1308 -- coerce %st(0) to the specified size
1309 gcoerceto DF = empty
1310 gcoerceto F = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1313 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1315 = hcat [text "fstp ", greg reg offset]
1317 bogus = text "\tbogus"
1318 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1323 gregno (RealReg i) = i
1324 gregno other = --pprPanic "gregno" (ppr other)
1325 999 -- bogus; only needed for debug printing
1327 pprG :: Instr -> Doc -> Doc
1329 = (char '#' <> pprGInstr fake) $$ actual
1331 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") DF src dst
1332 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1333 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1335 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") DF dst
1336 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") DF dst
1338 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F L src dst
1339 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") DF L src dst
1341 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") L F src dst
1342 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") L DF src dst
1344 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") DF co src dst
1345 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1346 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1347 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1348 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1349 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1350 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1352 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1353 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1354 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1355 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1358 Continue with I386-only printing bits and bobs:
1360 pprDollImm :: Imm -> Doc
1362 pprDollImm i = ptext SLIT("$") <> pprImm i
1364 pprOperand :: Size -> Operand -> Doc
1365 pprOperand s (OpReg r) = pprReg s r
1366 pprOperand s (OpImm i) = pprDollImm i
1367 pprOperand s (OpAddr ea) = pprAddr ea
1369 pprSizeImmOp :: LitString -> Size -> Imm -> Operand -> Doc
1370 pprSizeImmOp name size imm op1
1382 pprSizeOp :: LitString -> Size -> Operand -> Doc
1383 pprSizeOp name size op1
1392 pprSizeOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1393 pprSizeOpOp name size op1 op2
1399 pprOperand size op1,
1404 pprSizeByteOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1405 pprSizeByteOpOp name size op1 op2
1416 pprSizeOpReg :: LitString -> Size -> Operand -> Reg -> Doc
1417 pprSizeOpReg name size op1 reg
1423 pprOperand size op1,
1428 pprSizeReg :: LitString -> Size -> Reg -> Doc
1429 pprSizeReg name size reg1
1438 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1439 pprSizeRegReg name size reg1 reg2
1450 pprCondRegReg :: LitString -> Size -> Cond -> Reg -> Reg -> Doc
1451 pprCondRegReg name size cond reg1 reg2
1462 pprSizeSizeRegReg :: LitString -> Size -> Size -> Reg -> Reg -> Doc
1463 pprSizeSizeRegReg name size1 size2 reg1 reg2
1476 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1477 pprSizeRegRegReg name size reg1 reg2 reg3
1490 pprSizeAddr :: LitString -> Size -> MachRegsAddr -> Doc
1491 pprSizeAddr name size op
1500 pprSizeAddrReg :: LitString -> Size -> MachRegsAddr -> Reg -> Doc
1501 pprSizeAddrReg name size op dst
1512 pprSizeRegAddr :: LitString -> Size -> Reg -> MachRegsAddr -> Doc
1513 pprSizeRegAddr name size src op
1524 pprOpOp :: LitString -> Size -> Operand -> Operand -> Doc
1525 pprOpOp name size op1 op2
1529 pprOperand size op1,
1534 pprSizeOpOpCoerce :: LitString -> Size -> Size -> Operand -> Operand -> Doc
1535 pprSizeOpOpCoerce name size1 size2 op1 op2
1536 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1537 pprOperand size1 op1,
1539 pprOperand size2 op2
1542 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1543 pprCondInstr name cond arg
1544 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1546 #endif /* i386_TARGET_ARCH */
1549 %************************************************************************
1551 \subsubsection{@pprInstr@ for a SPARC}
1553 %************************************************************************
1556 #if sparc_TARGET_ARCH
1558 -- a clumsy hack for now, to handle possible double alignment problems
1560 -- even clumsier, to allow for RegReg regs that show when doing indexed
1561 -- reads (bytearrays).
1564 -- Translate to the following:
1567 -- ld [g1+4],%f(n+1)
1568 -- sub g1,g2,g1 -- to restore g1
1569 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1571 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1572 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1573 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1574 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1579 -- ld [addr+4],%f(n+1)
1580 pprInstr (LD DF addr reg) | isJust off_addr
1582 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1583 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1586 off_addr = addrOffset addr 4
1587 addr2 = case off_addr of Just x -> x
1590 pprInstr (LD size addr reg)
1601 -- The same clumsy hack as above
1603 -- Translate to the following:
1606 -- st %f(n+1),[g1+4]
1607 -- sub g1,g2,g1 -- to restore g1
1608 pprInstr (ST DF reg (AddrRegReg g1 g2))
1610 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1611 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1613 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1614 pprReg g1, ptext SLIT("+4]")],
1615 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1620 -- st %f(n+1),[addr+4]
1621 pprInstr (ST DF reg addr) | isJust off_addr
1623 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1624 pprAddr addr, rbrack],
1625 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1626 pprAddr addr2, rbrack]
1629 off_addr = addrOffset addr 4
1630 addr2 = case off_addr of Just x -> x
1632 -- no distinction is made between signed and unsigned bytes on stores for the
1633 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1634 -- so we call a special-purpose pprSize for ST..
1636 pprInstr (ST size reg addr)
1647 pprInstr (ADD x cc reg1 ri reg2)
1648 | not x && not cc && riZero ri
1649 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1651 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1653 pprInstr (SUB x cc reg1 ri reg2)
1654 | not x && cc && reg2 == g0
1655 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1656 | not x && not cc && riZero ri
1657 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1659 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1661 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1662 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1664 pprInstr (OR b reg1 ri reg2)
1665 | not b && reg1 == g0
1666 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1668 RIReg rrr | rrr == reg2 -> empty
1671 = pprRegRIReg SLIT("or") b reg1 ri reg2
1673 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1675 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1676 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1678 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1679 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1680 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1682 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1683 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1684 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1686 pprInstr (SETHI imm reg)
1688 ptext SLIT("\tsethi\t"),
1694 pprInstr NOP = ptext SLIT("\tnop")
1696 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1697 pprInstr (FABS DF reg1 reg2)
1698 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1699 (if (reg1 == reg2) then empty
1700 else (<>) (char '\n')
1701 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1703 pprInstr (FADD size reg1 reg2 reg3)
1704 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1705 pprInstr (FCMP e size reg1 reg2)
1706 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1707 pprInstr (FDIV size reg1 reg2 reg3)
1708 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1710 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1711 pprInstr (FMOV DF reg1 reg2)
1712 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1713 (if (reg1 == reg2) then empty
1714 else (<>) (char '\n')
1715 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1717 pprInstr (FMUL size reg1 reg2 reg3)
1718 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1720 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1721 pprInstr (FNEG DF reg1 reg2)
1722 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1723 (if (reg1 == reg2) then empty
1724 else (<>) (char '\n')
1725 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1727 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1728 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1729 pprInstr (FxTOy size1 size2 reg1 reg2)
1742 pprReg reg1, comma, pprReg reg2
1746 pprInstr (BI cond b lab)
1748 ptext SLIT("\tb"), pprCond cond,
1749 if b then pp_comma_a else empty,
1754 pprInstr (BF cond b lab)
1756 ptext SLIT("\tfb"), pprCond cond,
1757 if b then pp_comma_a else empty,
1762 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1764 pprInstr (CALL (Left imm) n _)
1765 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1766 pprInstr (CALL (Right reg) n _)
1767 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1770 Continue with SPARC-only printing bits and bobs:
1773 pprRI (RIReg r) = pprReg r
1774 pprRI (RIImm r) = pprImm r
1776 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1777 pprSizeRegReg name size reg1 reg2
1782 F -> ptext SLIT("s\t")
1783 DF -> ptext SLIT("d\t")),
1789 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1790 pprSizeRegRegReg name size reg1 reg2 reg3
1795 F -> ptext SLIT("s\t")
1796 DF -> ptext SLIT("d\t")),
1804 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
1805 pprRegRIReg name b reg1 ri reg2
1809 if b then ptext SLIT("cc\t") else char '\t',
1817 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
1818 pprRIReg name b ri reg1
1822 if b then ptext SLIT("cc\t") else char '\t',
1828 pp_ld_lbracket = ptext SLIT("\tld\t[")
1829 pp_rbracket_comma = text "],"
1830 pp_comma_lbracket = text ",["
1831 pp_comma_a = text ",a"
1833 #endif /* sparc_TARGET_ARCH */
1836 %************************************************************************
1838 \subsubsection{@pprInstr@ for PowerPC}
1840 %************************************************************************
1843 #if powerpc_TARGET_ARCH
1844 pprInstr (LD sz reg addr) = hcat [
1860 pprInstr (ST sz reg addr) = hcat [
1869 pprInstr (STU sz reg addr) = hcat [
1878 pprInstr (LIS reg imm) = hcat [
1886 pprInstr (LI reg imm) = hcat [
1894 pprInstr (MR reg1 reg2)
1895 | reg1 == reg2 = empty
1896 | otherwise = hcat [
1898 case regClass reg1 of
1899 RcInteger -> ptext SLIT("mr")
1900 _ -> ptext SLIT("fmr"),
1906 pprInstr (CMP sz reg ri) = hcat [
1922 pprInstr (CMPL sz reg ri) = hcat [
1938 pprInstr (BCC cond lbl) = hcat [
1946 pprInstr (MTCTR reg) = hcat [
1948 ptext SLIT("mtctr"),
1952 pprInstr (BCTR _) = hcat [
1956 pprInstr (BL imm _) = hcat [
1962 pprInstr (BCTRL _) = hcat [
1966 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
1967 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
1968 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
1969 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
1970 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
1971 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
1973 -- for some reason, "andi" doesn't exist.
1974 -- we'll use "andi." instead.
1975 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
1977 ptext SLIT("andi."),
1985 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
1987 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
1988 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
1990 pprInstr (XORIS reg1 reg2 imm) = hcat [
1992 ptext SLIT("xoris"),
2001 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 ri
2002 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 ri
2003 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 ri
2004 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2005 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2007 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2008 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2009 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2010 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2011 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2013 pprInstr (FCMP reg1 reg2) = hcat [
2015 ptext SLIT("fcmpu\tcr0, "),
2016 -- Note: we're using fcmpu, not fcmpo
2017 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2018 -- We don't handle invalid fp ops, so we don't care
2024 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2026 pprInstr _ = ptext SLIT("something")
2028 pprLogic op reg1 reg2 ri = hcat [
2033 RIImm _ -> char 'i',
2042 pprUnary op reg1 reg2 = hcat [
2051 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2064 pprRI (RIReg r) = pprReg r
2065 pprRI (RIImm r) = pprImm r
2068 pprFSize F = char 's'
2071 The Mach-O object file format used in Darwin/Mac OS X needs a so-called
2072 "symbol stub" for every function that might be imported from a dynamic
2074 The stubs are always the same, and they are all output at the end of the
2075 generated assembly (see AsmCodeGen.lhs), so we don't use the Instr datatype.
2076 Instead, we just pretty-print it directly.
2079 #if darwin_TARGET_OS
2080 pprDyldSymbolStub fn =
2082 ptext SLIT(".symbol_stub"),
2083 ptext SLIT("L_") <> ftext fn <> ptext SLIT("$stub:"),
2084 ptext SLIT("\t.indirect_symbol _") <> ftext fn,
2085 ptext SLIT("\tlis r11,ha16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
2086 ptext SLIT("\tlwz r12,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)(r11)"),
2087 ptext SLIT("\tmtctr r12"),
2088 ptext SLIT("\taddi r11,r11,lo16(L_") <> ftext fn <> ptext SLIT("$lazy_ptr)"),
2089 ptext SLIT("\tbctr"),
2090 ptext SLIT(".lazy_symbol_pointer"),
2091 ptext SLIT("L_") <> ftext fn <> ptext SLIT("$lazy_ptr:"),
2092 ptext SLIT("\t.indirect_symbol _") <> ftext fn,
2093 ptext SLIT("\t.long dyld_stub_binding_helper")
2098 #endif /* powerpc_TARGET_ARCH */
2102 #if __GLASGOW_HASKELL__ >= 504
2103 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
2104 newFloatArray = newArray_
2106 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
2107 newDoubleArray = newArray_
2109 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2110 castFloatToCharArray = castSTUArray
2112 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2113 castDoubleToCharArray = castSTUArray
2115 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
2116 writeFloatArray = writeArray
2118 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
2119 writeDoubleArray = writeArray
2121 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
2122 readCharArray arr i = do
2123 w <- readArray arr i
2124 return $! (chr (fromIntegral w))
2128 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2129 castFloatToCharArray = return
2131 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2134 castDoubleToCharArray = return
2138 -- floatToBytes and doubleToBytes convert to the host's byte
2139 -- order. Providing that we're not cross-compiling for a
2140 -- target with the opposite endianness, this should work ok
2143 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2144 -- could they be merged?
2146 floatToBytes :: Float -> [Int]
2149 arr <- newFloatArray ((0::Int),3)
2150 writeFloatArray arr 0 f
2151 arr <- castFloatToCharArray arr
2152 i0 <- readCharArray arr 0
2153 i1 <- readCharArray arr 1
2154 i2 <- readCharArray arr 2
2155 i3 <- readCharArray arr 3
2156 return (map ord [i0,i1,i2,i3])
2159 doubleToBytes :: Double -> [Int]
2162 arr <- newDoubleArray ((0::Int),7)
2163 writeDoubleArray arr 0 d
2164 arr <- castDoubleToCharArray arr
2165 i0 <- readCharArray arr 0
2166 i1 <- readCharArray arr 1
2167 i2 <- readCharArray arr 2
2168 i3 <- readCharArray arr 3
2169 i4 <- readCharArray arr 4
2170 i5 <- readCharArray arr 5
2171 i6 <- readCharArray arr 6
2172 i7 <- readCharArray arr 7
2173 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])