1 -----------------------------------------------------------------------------
3 -- Pretty-printing assembly language
5 -- (c) The University of Glasgow 1993-2005
7 -----------------------------------------------------------------------------
9 -- We start with the @pprXXX@s with some cross-platform commonality
10 -- (e.g., 'pprReg'); we conclude with the no-commonality monster,
13 #include "nativeGen/NCG.h"
16 pprNatCmmTop, pprBasicBlock, pprSectionHeader, pprData,
17 pprInstr, pprSize, pprUserReg
21 #include "HsVersions.h"
24 import MachOp ( MachRep(..), wordRep, isFloatingRep )
25 import MachRegs -- may differ per-platform
28 import CLabel ( CLabel, pprCLabel, externallyVisibleCLabel,
29 labelDynamic, mkAsmTempLabel, entryLblToInfoLbl )
30 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
31 import CLabel ( mkDeadStripPreventer )
34 import Panic ( panic )
35 import Unique ( pprUnique )
38 import qualified Outputable
39 import Outputable ( Outputable )
42 import Data.Word ( Word8 )
43 import Control.Monad.ST
44 import Data.Char ( chr, ord )
45 import Data.Maybe ( isJust )
47 #if powerpc_TARGET_ARCH || darwin_TARGET_OS
48 import Data.Word(Word32)
52 -- -----------------------------------------------------------------------------
53 -- Printing this stuff out
55 asmSDoc d = Outputable.withPprStyleDoc (
56 Outputable.mkCodeStyle Outputable.AsmStyle) d
57 pprCLabel_asm l = asmSDoc (pprCLabel l)
59 pprNatCmmTop :: NatCmmTop -> Doc
60 pprNatCmmTop (CmmData section dats) =
61 pprSectionHeader section $$ vcat (map pprData dats)
63 -- special case for split markers:
64 pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
66 pprNatCmmTop (CmmProc info lbl params blocks) =
67 pprSectionHeader Text $$
70 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
71 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
74 vcat (map pprData info) $$
75 pprLabel (entryLblToInfoLbl lbl)
79 (BasicBlock _ instrs : rest) ->
80 (if null info then pprLabel lbl else empty) $$
81 -- the first block doesn't get a label:
82 vcat (map pprInstr instrs) $$
83 vcat (map pprBasicBlock rest)
85 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
86 -- If we are using the .subsections_via_symbols directive
87 -- (available on recent versions of Darwin),
88 -- we have to make sure that there is some kind of reference
89 -- from the entry code to a label on the _top_ of of the info table,
90 -- so that the linker will not think it is unreferenced and dead-strip
91 -- it. That's why the label is called a DeadStripPreventer (_dsp).
94 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
96 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
101 pprBasicBlock :: NatBasicBlock -> Doc
102 pprBasicBlock (BasicBlock (BlockId id) instrs) =
103 pprLabel (mkAsmTempLabel id) $$
104 vcat (map pprInstr instrs)
106 -- -----------------------------------------------------------------------------
107 -- pprReg: print a 'Reg'
109 -- For x86, the way we print a register name depends
110 -- on which bit of it we care about. Yurgh.
112 pprUserReg :: Reg -> Doc
113 pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
115 pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
117 pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
119 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i
120 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
121 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
122 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
123 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
125 #if alpha_TARGET_ARCH
126 ppr_reg_no :: Int -> Doc
129 0 -> SLIT("$0"); 1 -> SLIT("$1");
130 2 -> SLIT("$2"); 3 -> SLIT("$3");
131 4 -> SLIT("$4"); 5 -> SLIT("$5");
132 6 -> SLIT("$6"); 7 -> SLIT("$7");
133 8 -> SLIT("$8"); 9 -> SLIT("$9");
134 10 -> SLIT("$10"); 11 -> SLIT("$11");
135 12 -> SLIT("$12"); 13 -> SLIT("$13");
136 14 -> SLIT("$14"); 15 -> SLIT("$15");
137 16 -> SLIT("$16"); 17 -> SLIT("$17");
138 18 -> SLIT("$18"); 19 -> SLIT("$19");
139 20 -> SLIT("$20"); 21 -> SLIT("$21");
140 22 -> SLIT("$22"); 23 -> SLIT("$23");
141 24 -> SLIT("$24"); 25 -> SLIT("$25");
142 26 -> SLIT("$26"); 27 -> SLIT("$27");
143 28 -> SLIT("$28"); 29 -> SLIT("$29");
144 30 -> SLIT("$30"); 31 -> SLIT("$31");
145 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
146 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
147 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
148 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
149 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
150 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
151 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
152 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
153 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
154 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
155 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
156 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
157 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
158 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
159 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
160 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
161 _ -> SLIT("very naughty alpha register")
165 ppr_reg_no :: MachRep -> Int -> Doc
166 ppr_reg_no I8 = ppr_reg_byte
167 ppr_reg_no I16 = ppr_reg_word
168 ppr_reg_no _ = ppr_reg_long
170 ppr_reg_byte i = ptext
172 0 -> SLIT("%al"); 1 -> SLIT("%bl");
173 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
174 _ -> SLIT("very naughty I386 byte register")
177 ppr_reg_word i = ptext
179 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
180 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
181 4 -> SLIT("%si"); 5 -> SLIT("%di");
182 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
183 _ -> SLIT("very naughty I386 word register")
186 ppr_reg_long i = ptext
188 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
189 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
190 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
191 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
192 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
193 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
194 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
195 _ -> SLIT("very naughty I386 register")
199 #if x86_64_TARGET_ARCH
200 ppr_reg_no :: MachRep -> Int -> Doc
201 ppr_reg_no I8 = ppr_reg_byte
202 ppr_reg_no I16 = ppr_reg_word
203 ppr_reg_no I32 = ppr_reg_long
204 ppr_reg_no _ = ppr_reg_quad
206 ppr_reg_byte i = ptext
208 0 -> SLIT("%al"); 1 -> SLIT("%bl");
209 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
210 4 -> SLIT("%sil"); 5 -> SLIT("%dil"); -- new 8-bit regs!
211 6 -> SLIT("%bpl"); 7 -> SLIT("%spl");
212 8 -> SLIT("%r8b"); 9 -> SLIT("%r9b");
213 10 -> SLIT("%r10b"); 11 -> SLIT("%r11b");
214 12 -> SLIT("%r12b"); 13 -> SLIT("%r13b");
215 14 -> SLIT("%r14b"); 15 -> SLIT("%r15b");
216 _ -> SLIT("very naughty x86_64 byte register")
219 ppr_reg_word i = ptext
221 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
222 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
223 4 -> SLIT("%si"); 5 -> SLIT("%di");
224 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
225 8 -> SLIT("%r8w"); 9 -> SLIT("%r9w");
226 10 -> SLIT("%r10w"); 11 -> SLIT("%r11w");
227 12 -> SLIT("%r12w"); 13 -> SLIT("%r13w");
228 14 -> SLIT("%r14w"); 15 -> SLIT("%r15w");
229 _ -> SLIT("very naughty x86_64 word register")
232 ppr_reg_long i = ptext
234 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
235 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
236 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
237 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
238 8 -> SLIT("%r8d"); 9 -> SLIT("%r9d");
239 10 -> SLIT("%r10d"); 11 -> SLIT("%r11d");
240 12 -> SLIT("%r12d"); 13 -> SLIT("%r13d");
241 14 -> SLIT("%r14d"); 15 -> SLIT("%r15d");
242 _ -> SLIT("very naughty x86_64 register")
245 ppr_reg_quad i = ptext
247 0 -> SLIT("%rax"); 1 -> SLIT("%rbx");
248 2 -> SLIT("%rcx"); 3 -> SLIT("%rdx");
249 4 -> SLIT("%rsi"); 5 -> SLIT("%rdi");
250 6 -> SLIT("%rbp"); 7 -> SLIT("%rsp");
251 8 -> SLIT("%r8"); 9 -> SLIT("%r9");
252 10 -> SLIT("%r10"); 11 -> SLIT("%r11");
253 12 -> SLIT("%r12"); 13 -> SLIT("%r13");
254 14 -> SLIT("%r14"); 15 -> SLIT("%r15");
255 16 -> SLIT("%xmm0"); 17 -> SLIT("%xmm1");
256 18 -> SLIT("%xmm2"); 19 -> SLIT("%xmm3");
257 20 -> SLIT("%xmm4"); 21 -> SLIT("%xmm5");
258 22 -> SLIT("%xmm6"); 23 -> SLIT("%xmm7");
259 24 -> SLIT("%xmm8"); 25 -> SLIT("%xmm9");
260 26 -> SLIT("%xmm10"); 27 -> SLIT("%xmm11");
261 28 -> SLIT("%xmm12"); 29 -> SLIT("%xmm13");
262 30 -> SLIT("%xmm14"); 31 -> SLIT("%xmm15");
263 _ -> SLIT("very naughty x86_64 register")
267 #if sparc_TARGET_ARCH
268 ppr_reg_no :: Int -> Doc
271 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
272 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
273 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
274 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
275 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
276 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
277 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
278 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
279 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
280 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
281 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
282 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
283 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
284 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
285 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
286 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
287 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
288 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
289 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
290 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
291 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
292 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
293 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
294 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
295 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
296 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
297 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
298 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
299 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
300 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
301 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
302 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
303 _ -> SLIT("very naughty sparc register")
306 #if powerpc_TARGET_ARCH
308 ppr_reg_no :: Int -> Doc
311 0 -> SLIT("r0"); 1 -> SLIT("r1");
312 2 -> SLIT("r2"); 3 -> SLIT("r3");
313 4 -> SLIT("r4"); 5 -> SLIT("r5");
314 6 -> SLIT("r6"); 7 -> SLIT("r7");
315 8 -> SLIT("r8"); 9 -> SLIT("r9");
316 10 -> SLIT("r10"); 11 -> SLIT("r11");
317 12 -> SLIT("r12"); 13 -> SLIT("r13");
318 14 -> SLIT("r14"); 15 -> SLIT("r15");
319 16 -> SLIT("r16"); 17 -> SLIT("r17");
320 18 -> SLIT("r18"); 19 -> SLIT("r19");
321 20 -> SLIT("r20"); 21 -> SLIT("r21");
322 22 -> SLIT("r22"); 23 -> SLIT("r23");
323 24 -> SLIT("r24"); 25 -> SLIT("r25");
324 26 -> SLIT("r26"); 27 -> SLIT("r27");
325 28 -> SLIT("r28"); 29 -> SLIT("r29");
326 30 -> SLIT("r30"); 31 -> SLIT("r31");
327 32 -> SLIT("f0"); 33 -> SLIT("f1");
328 34 -> SLIT("f2"); 35 -> SLIT("f3");
329 36 -> SLIT("f4"); 37 -> SLIT("f5");
330 38 -> SLIT("f6"); 39 -> SLIT("f7");
331 40 -> SLIT("f8"); 41 -> SLIT("f9");
332 42 -> SLIT("f10"); 43 -> SLIT("f11");
333 44 -> SLIT("f12"); 45 -> SLIT("f13");
334 46 -> SLIT("f14"); 47 -> SLIT("f15");
335 48 -> SLIT("f16"); 49 -> SLIT("f17");
336 50 -> SLIT("f18"); 51 -> SLIT("f19");
337 52 -> SLIT("f20"); 53 -> SLIT("f21");
338 54 -> SLIT("f22"); 55 -> SLIT("f23");
339 56 -> SLIT("f24"); 57 -> SLIT("f25");
340 58 -> SLIT("f26"); 59 -> SLIT("f27");
341 60 -> SLIT("f28"); 61 -> SLIT("f29");
342 62 -> SLIT("f30"); 63 -> SLIT("f31");
343 _ -> SLIT("very naughty powerpc register")
346 ppr_reg_no :: Int -> Doc
347 ppr_reg_no i | i <= 31 = int i -- GPRs
348 | i <= 63 = int (i-32) -- FPRs
349 | otherwise = ptext SLIT("very naughty powerpc register")
354 -- -----------------------------------------------------------------------------
355 -- pprSize: print a 'Size'
357 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
358 pprSize :: MachRep -> Doc
360 pprSize :: Size -> Doc
363 pprSize x = ptext (case x of
364 #if alpha_TARGET_ARCH
367 -- W -> SLIT("w") UNUSED
368 -- Wu -> SLIT("wu") UNUSED
371 -- FF -> SLIT("f") UNUSED
372 -- DF -> SLIT("d") UNUSED
373 -- GF -> SLIT("g") UNUSED
374 -- SF -> SLIT("s") UNUSED
377 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
388 #if x86_64_TARGET_ARCH
389 F32 -> SLIT("ss") -- "scalar single-precision float" (SSE2)
390 F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2)
392 #if sparc_TARGET_ARCH
399 pprStSize :: MachRep -> Doc
400 pprStSize x = ptext (case x of
407 #if powerpc_TARGET_ARCH
416 -- -----------------------------------------------------------------------------
417 -- pprCond: print a 'Cond'
419 pprCond :: Cond -> Doc
421 pprCond c = ptext (case c of {
422 #if alpha_TARGET_ARCH
432 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
433 GEU -> SLIT("ae"); LU -> SLIT("b");
434 EQQ -> SLIT("e"); GTT -> SLIT("g");
435 GE -> SLIT("ge"); GU -> SLIT("a");
436 LTT -> SLIT("l"); LE -> SLIT("le");
437 LEU -> SLIT("be"); NE -> SLIT("ne");
438 NEG -> SLIT("s"); POS -> SLIT("ns");
439 CARRY -> SLIT("c"); OFLO -> SLIT("o");
440 PARITY -> SLIT("p"); NOTPARITY -> SLIT("np");
441 ALWAYS -> SLIT("mp") -- hack
443 #if sparc_TARGET_ARCH
444 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
445 GEU -> SLIT("geu"); LU -> SLIT("lu");
446 EQQ -> SLIT("e"); GTT -> SLIT("g");
447 GE -> SLIT("ge"); GU -> SLIT("gu");
448 LTT -> SLIT("l"); LE -> SLIT("le");
449 LEU -> SLIT("leu"); NE -> SLIT("ne");
450 NEG -> SLIT("neg"); POS -> SLIT("pos");
451 VC -> SLIT("vc"); VS -> SLIT("vs")
453 #if powerpc_TARGET_ARCH
455 EQQ -> SLIT("eq"); NE -> SLIT("ne");
456 LTT -> SLIT("lt"); GE -> SLIT("ge");
457 GTT -> SLIT("gt"); LE -> SLIT("le");
458 LU -> SLIT("lt"); GEU -> SLIT("ge");
459 GU -> SLIT("gt"); LEU -> SLIT("le");
464 -- -----------------------------------------------------------------------------
465 -- pprImm: print an 'Imm'
469 pprImm (ImmInt i) = int i
470 pprImm (ImmInteger i) = integer i
471 pprImm (ImmCLbl l) = pprCLabel_asm l
472 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
473 pprImm (ImmLit s) = s
475 pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
476 pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
478 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
479 #if sparc_TARGET_ARCH
480 -- ToDo: This should really be fixed in the PIC support, but only
482 pprImm (ImmConstantDiff a b) = pprImm a
484 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
485 <> lparen <> pprImm b <> rparen
488 #if sparc_TARGET_ARCH
490 = hcat [ pp_lo, pprImm i, rparen ]
495 = hcat [ pp_hi, pprImm i, rparen ]
499 #if powerpc_TARGET_ARCH
502 = hcat [ pp_lo, pprImm i, rparen ]
507 = hcat [ pp_hi, pprImm i, rparen ]
512 = hcat [ pp_ha, pprImm i, rparen ]
518 = pprImm i <> text "@l"
521 = pprImm i <> text "@h"
524 = pprImm i <> text "@ha"
529 -- -----------------------------------------------------------------------------
530 -- @pprAddr: print an 'AddrMode'
532 pprAddr :: AddrMode -> Doc
534 #if alpha_TARGET_ARCH
535 pprAddr (AddrReg r) = parens (pprReg r)
536 pprAddr (AddrImm i) = pprImm i
537 pprAddr (AddrRegImm r1 i)
538 = (<>) (pprImm i) (parens (pprReg r1))
543 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
544 pprAddr (ImmAddr imm off)
545 = let pp_imm = pprImm imm
549 else if (off < 0) then
552 pp_imm <> char '+' <> int off
554 pprAddr (AddrBaseIndex base index displacement)
556 pp_disp = ppr_disp displacement
557 pp_off p = pp_disp <> char '(' <> p <> char ')'
558 pp_reg r = pprReg wordRep r
561 (EABaseNone, EAIndexNone) -> pp_disp
562 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
563 (EABaseRip, EAIndexNone) -> pp_off (ptext SLIT("%rip"))
564 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
565 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
568 ppr_disp (ImmInt 0) = empty
569 ppr_disp imm = pprImm imm
574 #if sparc_TARGET_ARCH
575 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
577 pprAddr (AddrRegReg r1 r2)
578 = hcat [ pprReg r1, char '+', pprReg r2 ]
580 pprAddr (AddrRegImm r1 (ImmInt i))
582 | not (fits13Bits i) = largeOffsetError i
583 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
585 pp_sign = if i > 0 then char '+' else empty
587 pprAddr (AddrRegImm r1 (ImmInteger i))
589 | not (fits13Bits i) = largeOffsetError i
590 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
592 pp_sign = if i > 0 then char '+' else empty
594 pprAddr (AddrRegImm r1 imm)
595 = hcat [ pprReg r1, char '+', pprImm imm ]
600 #if powerpc_TARGET_ARCH
601 pprAddr (AddrRegReg r1 r2)
602 = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
604 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
605 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
606 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
610 -- -----------------------------------------------------------------------------
611 -- pprData: print a 'CmmStatic'
613 pprSectionHeader Text
615 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
616 ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
617 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".text\n\t.align 2"),
618 SLIT(".text\n\t.align 4,0x90"))
619 {-needs per-OS variation!-}
620 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".text\n.align 3"),
621 SLIT(".text\n\t.align 8"))
622 ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
624 pprSectionHeader Data
626 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
627 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
628 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
629 SLIT(".data\n\t.align 4"))
630 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n.align 3"),
631 SLIT(".data\n\t.align 8"))
632 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
634 pprSectionHeader ReadOnlyData
636 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
637 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
638 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"),
639 SLIT(".section .rodata\n\t.align 4"))
640 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 3"),
641 SLIT(".section .rodata\n\t.align 8"))
642 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
643 SLIT(".section .rodata\n\t.align 2"))
645 pprSectionHeader RelocatableReadOnlyData
647 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
648 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
649 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
650 SLIT(".section .data\n\t.align 4"))
651 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const_data\n.align 3"),
652 SLIT(".section .data\n\t.align 8"))
653 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
654 SLIT(".data\n\t.align 2"))
656 pprSectionHeader UninitialisedData
658 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
659 ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
660 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
661 SLIT(".section .bss\n\t.align 4"))
662 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n\t.align 3"),
663 SLIT(".section .bss\n\t.align 8"))
664 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
665 SLIT(".section .bss\n\t.align 2"))
667 pprSectionHeader ReadOnlyData16
669 IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
670 ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
671 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 4"),
672 SLIT(".section .rodata\n\t.align 16"))
673 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 4"),
674 SLIT(".section .rodata.cst16\n\t.align 16"))
675 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
676 SLIT(".section .rodata\n\t.align 4"))
679 pprSectionHeader (OtherSection sec)
680 = panic "PprMach.pprSectionHeader: unknown section"
682 pprData :: CmmStatic -> Doc
683 pprData (CmmAlign bytes) = pprAlign bytes
684 pprData (CmmDataLabel lbl) = pprLabel lbl
685 pprData (CmmString str) = pprASCII str
686 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
687 pprData (CmmStaticLit lit) = pprDataItem lit
689 pprGloblDecl :: CLabel -> Doc
691 | not (externallyVisibleCLabel lbl) = empty
692 | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
696 pprTypeAndSizeDecl :: CLabel -> Doc
697 pprTypeAndSizeDecl lbl
699 | not (externallyVisibleCLabel lbl) = empty
700 | otherwise = ptext SLIT(".type ") <>
701 pprCLabel_asm lbl <> ptext SLIT(", @object")
706 pprLabel :: CLabel -> Doc
707 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
711 = vcat (map do1 str) $$ do1 0
714 do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
717 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
718 IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
719 IF_ARCH_x86_64(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
720 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
721 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
725 log2 :: Int -> Int -- cache the common ones
730 log2 n = 1 + log2 (n `quot` 2)
733 pprDataItem :: CmmLit -> Doc
735 = vcat (ppr_item (cmmLitRep lit) lit)
739 -- These seem to be common:
740 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
741 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
742 ppr_item F32 (CmmFloat r _)
743 = let bs = floatToBytes (fromRational r)
744 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
745 ppr_item F64 (CmmFloat r _)
746 = let bs = doubleToBytes (fromRational r)
747 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
749 #if sparc_TARGET_ARCH
750 -- copy n paste of x86 version
751 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
752 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
754 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
755 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
757 #if i386_TARGET_ARCH && darwin_TARGET_OS
758 ppr_item I64 (CmmInt x _) =
759 [ptext SLIT("\t.long\t")
760 <> int (fromIntegral (fromIntegral x :: Word32)),
761 ptext SLIT("\t.long\t")
763 (fromIntegral (x `shiftR` 32) :: Word32))]
765 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
766 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
768 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
769 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
770 -- type, which means we can't do pc-relative 64-bit addresses.
771 -- Fortunately we're assuming the small memory model, in which
772 -- all such offsets will fit into 32 bits, so we have to stick
773 -- to 32-bit offset fields and modify the RTS appropriately
775 -- See Note [x86-64-relative] in includes/InfoTables.h
778 | isRelativeReloc x =
779 [ptext SLIT("\t.long\t") <> pprImm imm,
780 ptext SLIT("\t.long\t0")]
782 [ptext SLIT("\t.quad\t") <> pprImm imm]
784 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
785 isRelativeReloc _ = False
787 #if powerpc_TARGET_ARCH
788 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
789 ppr_item I64 (CmmInt x _) =
790 [ptext SLIT("\t.long\t")
792 (fromIntegral (x `shiftR` 32) :: Word32)),
793 ptext SLIT("\t.long\t")
794 <> int (fromIntegral (fromIntegral x :: Word32))]
797 -- fall through to rest of (machine-specific) pprInstr...
799 -- -----------------------------------------------------------------------------
800 -- pprInstr: print an 'Instr'
802 instance Outputable Instr where
803 ppr instr = Outputable.docToSDoc $ pprInstr instr
805 pprInstr :: Instr -> Doc
807 --pprInstr (COMMENT s) = empty -- nuke 'em
809 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
810 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
811 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
812 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
813 ,IF_ARCH_powerpc( IF_OS_linux(
814 ((<>) (ptext SLIT("# ")) (ftext s)),
815 ((<>) (ptext SLIT("; ")) (ftext s)))
819 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
821 pprInstr (NEWBLOCK _)
822 = panic "PprMach.pprInstr: NEWBLOCK"
825 = panic "PprMach.pprInstr: LDATA"
827 -- -----------------------------------------------------------------------------
828 -- pprInstr for an Alpha
830 #if alpha_TARGET_ARCH
832 pprInstr (LD size reg addr)
842 pprInstr (LDA reg addr)
844 ptext SLIT("\tlda\t"),
850 pprInstr (LDAH reg addr)
852 ptext SLIT("\tldah\t"),
858 pprInstr (LDGP reg addr)
860 ptext SLIT("\tldgp\t"),
866 pprInstr (LDI size reg imm)
876 pprInstr (ST size reg addr)
888 ptext SLIT("\tclr\t"),
892 pprInstr (ABS size ri reg)
902 pprInstr (NEG size ov ri reg)
906 if ov then ptext SLIT("v\t") else char '\t',
912 pprInstr (ADD size ov reg1 ri reg2)
916 if ov then ptext SLIT("v\t") else char '\t',
924 pprInstr (SADD size scale reg1 ri reg2)
926 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
937 pprInstr (SUB size ov reg1 ri reg2)
941 if ov then ptext SLIT("v\t") else char '\t',
949 pprInstr (SSUB size scale reg1 ri reg2)
951 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
962 pprInstr (MUL size ov reg1 ri reg2)
966 if ov then ptext SLIT("v\t") else char '\t',
974 pprInstr (DIV size uns reg1 ri reg2)
978 if uns then ptext SLIT("u\t") else char '\t',
986 pprInstr (REM size uns reg1 ri reg2)
990 if uns then ptext SLIT("u\t") else char '\t',
998 pprInstr (NOT ri reg)
1000 ptext SLIT("\tnot"),
1007 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
1008 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
1009 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
1010 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
1011 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
1012 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
1014 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
1015 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
1016 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
1018 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
1019 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
1021 pprInstr (NOP) = ptext SLIT("\tnop")
1023 pprInstr (CMP cond reg1 ri reg2)
1025 ptext SLIT("\tcmp"),
1037 ptext SLIT("\tfclr\t"),
1041 pprInstr (FABS reg1 reg2)
1043 ptext SLIT("\tfabs\t"),
1049 pprInstr (FNEG size reg1 reg2)
1051 ptext SLIT("\tneg"),
1059 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1060 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1061 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1062 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1064 pprInstr (CVTxy size1 size2 reg1 reg2)
1066 ptext SLIT("\tcvt"),
1068 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1075 pprInstr (FCMP size cond reg1 reg2 reg3)
1077 ptext SLIT("\tcmp"),
1088 pprInstr (FMOV reg1 reg2)
1090 ptext SLIT("\tfmov\t"),
1096 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1098 pprInstr (BI NEVER reg lab) = empty
1100 pprInstr (BI cond reg lab)
1110 pprInstr (BF cond reg lab)
1121 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1123 pprInstr (JMP reg addr hint)
1125 ptext SLIT("\tjmp\t"),
1133 pprInstr (BSR imm n)
1134 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1136 pprInstr (JSR reg addr n)
1138 ptext SLIT("\tjsr\t"),
1144 pprInstr (FUNBEGIN clab)
1146 if (externallyVisibleCLabel clab) then
1147 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1150 ptext SLIT("\t.ent "),
1159 pp_lab = pprCLabel_asm clab
1161 -- NEVER use commas within those string literals, cpp will ruin your day
1162 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1163 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1164 ptext SLIT("4240"), char ',',
1165 ptext SLIT("$26"), char ',',
1166 ptext SLIT("0\n\t.prologue 1") ]
1168 pprInstr (FUNEND clab)
1169 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1172 Continue with Alpha-only printing bits and bobs:
1176 pprRI (RIReg r) = pprReg r
1177 pprRI (RIImm r) = pprImm r
1179 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1180 pprRegRIReg name reg1 ri reg2
1192 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1193 pprSizeRegRegReg name size reg1 reg2 reg3
1206 #endif /* alpha_TARGET_ARCH */
1209 -- -----------------------------------------------------------------------------
1210 -- pprInstr for an x86
1212 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1214 {- -- BUGS: changed for coloring allocator
1215 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack -- write a pass for this and patch linear allocator with it
1218 #if 0 /* #ifdef DEBUG */
1219 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1225 pprInstr (MOV size src dst)
1226 = pprSizeOpOp SLIT("mov") size src dst
1228 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1229 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1230 -- movl. But we represent it as a MOVZxL instruction, because
1231 -- the reg alloc would tend to throw away a plain reg-to-reg
1232 -- move, and we still want it to do that.
1234 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1235 -- zero-extension only needs to extend to 32 bits: on x86_64,
1236 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1237 -- instruction is shorter.
1239 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1241 -- here we do some patching, since the physical registers are only set late
1242 -- in the code generation.
1243 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1245 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1246 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1248 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1249 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1251 = pprInstr (ADD size (OpImm displ) dst)
1252 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1254 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1255 = pprSizeOp SLIT("dec") size dst
1256 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1257 = pprSizeOp SLIT("inc") size dst
1258 pprInstr (ADD size src dst)
1259 = pprSizeOpOp SLIT("add") size src dst
1260 pprInstr (ADC size src dst)
1261 = pprSizeOpOp SLIT("adc") size src dst
1262 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1263 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1265 {- A hack. The Intel documentation says that "The two and three
1266 operand forms [of IMUL] may also be used with unsigned operands
1267 because the lower half of the product is the same regardless if
1268 (sic) the operands are signed or unsigned. The CF and OF flags,
1269 however, cannot be used to determine if the upper half of the
1270 result is non-zero." So there.
1272 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1273 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1275 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1276 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1277 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1279 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1280 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1282 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1283 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1284 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1286 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1288 pprInstr (CMP size src dst)
1289 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1290 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1292 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1293 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1294 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1296 -- both unused (SDM):
1297 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1298 -- pprInstr POPA = ptext SLIT("\tpopal")
1300 pprInstr NOP = ptext SLIT("\tnop")
1301 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1302 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1304 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1306 pprInstr (JXX cond (BlockId id))
1307 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1308 where lab = mkAsmTempLabel id
1310 pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
1312 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1313 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1314 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1315 pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1316 pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1318 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1319 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1320 pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
1322 #if x86_64_TARGET_ARCH
1323 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1325 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1327 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1328 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1329 pprInstr (CVTTSS2SIQ from to) = pprOpReg SLIT("cvttss2siq") from to
1330 pprInstr (CVTTSD2SIQ from to) = pprOpReg SLIT("cvttsd2siq") from to
1331 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ssq") from to
1332 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sdq") from to
1335 -- FETCHGOT for PIC on ELF platforms
1336 pprInstr (FETCHGOT reg)
1337 = vcat [ ptext SLIT("\tcall 1f"),
1338 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1339 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1343 -- FETCHPC for PIC on Darwin/x86
1344 -- get the instruction pointer into a register
1345 -- (Terminology note: the IP is called Program Counter on PPC,
1346 -- and it's a good thing to use the same name on both platforms)
1347 pprInstr (FETCHPC reg)
1348 = vcat [ ptext SLIT("\tcall 1f"),
1349 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1356 -- -----------------------------------------------------------------------------
1357 -- i386 floating-point
1359 #if i386_TARGET_ARCH
1360 -- Simulating a flat register set on the x86 FP stack is tricky.
1361 -- you have to free %st(7) before pushing anything on the FP reg stack
1362 -- so as to preclude the possibility of a FP stack overflow exception.
1363 pprInstr g@(GMOV src dst)
1367 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1369 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1370 pprInstr g@(GLD sz addr dst)
1371 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1372 pprAddr addr, gsemi, gpop dst 1])
1374 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1375 pprInstr g@(GST sz src addr)
1376 = pprG g (hcat [gtab, gpush src 0, gsemi,
1377 text "fstp", pprSize sz, gsp, pprAddr addr])
1379 pprInstr g@(GLDZ dst)
1380 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1381 pprInstr g@(GLD1 dst)
1382 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1384 pprInstr g@(GFTOI src dst)
1385 = pprInstr (GDTOI src dst)
1386 pprInstr g@(GDTOI src dst)
1387 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1388 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1391 pprInstr g@(GITOF src dst)
1392 = pprInstr (GITOD src dst)
1393 pprInstr g@(GITOD src dst)
1394 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1395 text " ; ffree %st(7); fildl (%esp) ; ",
1396 gpop dst 1, text " ; addl $4,%esp"])
1398 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1399 this far into the jungle AND you give a Rat's Ass (tm) what's going
1400 on, here's the deal. Generate code to do a floating point comparison
1401 of src1 and src2, of kind cond, and set the Zero flag if true.
1403 The complications are to do with handling NaNs correctly. We want the
1404 property that if either argument is NaN, then the result of the
1405 comparison is False ... except if we're comparing for inequality,
1406 in which case the answer is True.
1408 Here's how the general (non-inequality) case works. As an
1409 example, consider generating the an equality test:
1411 pushl %eax -- we need to mess with this
1412 <get src1 to top of FPU stack>
1413 fcomp <src2 location in FPU stack> and pop pushed src1
1414 -- Result of comparison is in FPU Status Register bits
1416 fstsw %ax -- Move FPU Status Reg to %ax
1417 sahf -- move C3 C2 C0 from %ax to integer flag reg
1418 -- now the serious magic begins
1419 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1420 sete %al -- %al = if arg1 == arg2 then 1 else 0
1421 andb %ah,%al -- %al &= %ah
1422 -- so %al == 1 iff (comparable && same); else it holds 0
1423 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1424 else %al == 0xFF, ZeroFlag=0
1425 -- the zero flag is now set as we desire.
1428 The special case of inequality differs thusly:
1430 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1431 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1432 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1433 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1434 else (%al == 0xFF, ZF=0)
1436 pprInstr g@(GCMP cond src1 src2)
1437 | case cond of { NE -> True; other -> False }
1439 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1440 hcat [gtab, text "fcomp ", greg src2 1,
1441 text "; fstsw %ax ; sahf ; setpe %ah"],
1442 hcat [gtab, text "setne %al ; ",
1443 text "orb %ah,%al ; decb %al ; popl %eax"]
1447 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1448 hcat [gtab, text "fcomp ", greg src2 1,
1449 text "; fstsw %ax ; sahf ; setpo %ah"],
1450 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1451 text "andb %ah,%al ; decb %al ; popl %eax"]
1454 {- On the 486, the flags set by FP compare are the unsigned ones!
1455 (This looks like a HACK to me. WDP 96/03)
1457 fix_FP_cond :: Cond -> Cond
1458 fix_FP_cond GE = GEU
1459 fix_FP_cond GTT = GU
1460 fix_FP_cond LTT = LU
1461 fix_FP_cond LE = LEU
1462 fix_FP_cond EQQ = EQQ
1464 -- there should be no others
1467 pprInstr g@(GABS sz src dst)
1468 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1469 pprInstr g@(GNEG sz src dst)
1470 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1472 pprInstr g@(GSQRT sz src dst)
1473 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1474 hcat [gtab, gcoerceto sz, gpop dst 1])
1475 pprInstr g@(GSIN sz src dst)
1476 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1477 hcat [gtab, gcoerceto sz, gpop dst 1])
1478 pprInstr g@(GCOS sz src dst)
1479 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1480 hcat [gtab, gcoerceto sz, gpop dst 1])
1481 pprInstr g@(GTAN sz src dst)
1482 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1483 gpush src 0, text " ; fptan ; ",
1484 text " fstp %st(0)"] $$
1485 hcat [gtab, gcoerceto sz, gpop dst 1])
1487 -- In the translations for GADD, GMUL, GSUB and GDIV,
1488 -- the first two cases are mere optimisations. The otherwise clause
1489 -- generates correct code under all circumstances.
1491 pprInstr g@(GADD sz src1 src2 dst)
1493 = pprG g (text "\t#GADD-xxxcase1" $$
1494 hcat [gtab, gpush src2 0,
1495 text " ; faddp %st(0),", greg src1 1])
1497 = pprG g (text "\t#GADD-xxxcase2" $$
1498 hcat [gtab, gpush src1 0,
1499 text " ; faddp %st(0),", greg src2 1])
1501 = pprG g (hcat [gtab, gpush src1 0,
1502 text " ; fadd ", greg src2 1, text ",%st(0)",
1506 pprInstr g@(GMUL sz src1 src2 dst)
1508 = pprG g (text "\t#GMUL-xxxcase1" $$
1509 hcat [gtab, gpush src2 0,
1510 text " ; fmulp %st(0),", greg src1 1])
1512 = pprG g (text "\t#GMUL-xxxcase2" $$
1513 hcat [gtab, gpush src1 0,
1514 text " ; fmulp %st(0),", greg src2 1])
1516 = pprG g (hcat [gtab, gpush src1 0,
1517 text " ; fmul ", greg src2 1, text ",%st(0)",
1521 pprInstr g@(GSUB sz src1 src2 dst)
1523 = pprG g (text "\t#GSUB-xxxcase1" $$
1524 hcat [gtab, gpush src2 0,
1525 text " ; fsubrp %st(0),", greg src1 1])
1527 = pprG g (text "\t#GSUB-xxxcase2" $$
1528 hcat [gtab, gpush src1 0,
1529 text " ; fsubp %st(0),", greg src2 1])
1531 = pprG g (hcat [gtab, gpush src1 0,
1532 text " ; fsub ", greg src2 1, text ",%st(0)",
1536 pprInstr g@(GDIV sz src1 src2 dst)
1538 = pprG g (text "\t#GDIV-xxxcase1" $$
1539 hcat [gtab, gpush src2 0,
1540 text " ; fdivrp %st(0),", greg src1 1])
1542 = pprG g (text "\t#GDIV-xxxcase2" $$
1543 hcat [gtab, gpush src1 0,
1544 text " ; fdivp %st(0),", greg src2 1])
1546 = pprG g (hcat [gtab, gpush src1 0,
1547 text " ; fdiv ", greg src2 1, text ",%st(0)",
1552 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1553 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1556 --------------------------
1558 -- coerce %st(0) to the specified size
1559 gcoerceto F64 = empty
1560 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1563 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1565 = hcat [text "fstp ", greg reg offset]
1567 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1572 gregno (RealReg i) = i
1573 gregno other = --pprPanic "gregno" (ppr other)
1574 999 -- bogus; only needed for debug printing
1576 pprG :: Instr -> Doc -> Doc
1578 = (char '#' <> pprGInstr fake) $$ actual
1580 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1581 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1582 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1584 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1585 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1587 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1588 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1590 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1591 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1593 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1594 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1595 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1596 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1597 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1598 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1599 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1601 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1602 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1603 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1604 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1607 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1609 -- Continue with I386-only printing bits and bobs:
1611 pprDollImm :: Imm -> Doc
1613 pprDollImm i = ptext SLIT("$") <> pprImm i
1615 pprOperand :: MachRep -> Operand -> Doc
1616 pprOperand s (OpReg r) = pprReg s r
1617 pprOperand s (OpImm i) = pprDollImm i
1618 pprOperand s (OpAddr ea) = pprAddr ea
1620 pprMnemonic_ :: LitString -> Doc
1622 char '\t' <> ptext name <> space
1624 pprMnemonic :: LitString -> MachRep -> Doc
1625 pprMnemonic name size =
1626 char '\t' <> ptext name <> pprSize size <> space
1628 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1629 pprSizeImmOp name size imm op1
1631 pprMnemonic name size,
1638 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1639 pprSizeOp name size op1
1641 pprMnemonic name size,
1645 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1646 pprSizeOpOp name size op1 op2
1648 pprMnemonic name size,
1649 pprOperand size op1,
1654 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1655 pprOpOp name size op1 op2
1658 pprOperand size op1,
1663 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1664 pprSizeReg name size reg1
1666 pprMnemonic name size,
1670 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1671 pprSizeRegReg name size reg1 reg2
1673 pprMnemonic name size,
1679 pprRegReg :: LitString -> Reg -> Reg -> Doc
1680 pprRegReg name reg1 reg2
1683 pprReg wordRep reg1,
1688 pprOpReg :: LitString -> Operand -> Reg -> Doc
1689 pprOpReg name op1 reg2
1692 pprOperand wordRep op1,
1697 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1698 pprCondRegReg name size cond reg1 reg2
1709 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1710 pprSizeSizeRegReg name size1 size2 reg1 reg2
1723 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1724 pprSizeRegRegReg name size reg1 reg2 reg3
1726 pprMnemonic name size,
1734 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1735 pprSizeAddrReg name size op dst
1737 pprMnemonic name size,
1743 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1744 pprSizeRegAddr name size src op
1746 pprMnemonic name size,
1752 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1753 pprShift name size src dest
1755 pprMnemonic name size,
1756 pprOperand I8 src, -- src is 8-bit sized
1758 pprOperand size dest
1761 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1762 pprSizeOpOpCoerce name size1 size2 op1 op2
1763 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1764 pprOperand size1 op1,
1766 pprOperand size2 op2
1769 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1770 pprCondInstr name cond arg
1771 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1773 #endif /* i386_TARGET_ARCH */
1776 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1778 #if sparc_TARGET_ARCH
1780 -- a clumsy hack for now, to handle possible double alignment problems
1782 -- even clumsier, to allow for RegReg regs that show when doing indexed
1783 -- reads (bytearrays).
1786 -- Translate to the following:
1789 -- ld [g1+4],%f(n+1)
1790 -- sub g1,g2,g1 -- to restore g1
1792 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1794 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1795 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1796 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1797 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1802 -- ld [addr+4],%f(n+1)
1803 pprInstr (LD F64 addr reg) | isJust off_addr
1805 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1806 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1809 off_addr = addrOffset addr 4
1810 addr2 = case off_addr of Just x -> x
1813 pprInstr (LD size addr reg)
1824 -- The same clumsy hack as above
1826 -- Translate to the following:
1829 -- st %f(n+1),[g1+4]
1830 -- sub g1,g2,g1 -- to restore g1
1831 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1833 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1834 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1836 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1837 pprReg g1, ptext SLIT("+4]")],
1838 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1843 -- st %f(n+1),[addr+4]
1844 pprInstr (ST F64 reg addr) | isJust off_addr
1846 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1847 pprAddr addr, rbrack],
1848 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1849 pprAddr addr2, rbrack]
1852 off_addr = addrOffset addr 4
1853 addr2 = case off_addr of Just x -> x
1855 -- no distinction is made between signed and unsigned bytes on stores for the
1856 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1857 -- so we call a special-purpose pprSize for ST..
1859 pprInstr (ST size reg addr)
1870 pprInstr (ADD x cc reg1 ri reg2)
1871 | not x && not cc && riZero ri
1872 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1874 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1876 pprInstr (SUB x cc reg1 ri reg2)
1877 | not x && cc && reg2 == g0
1878 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1879 | not x && not cc && riZero ri
1880 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1882 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1884 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1885 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1887 pprInstr (OR b reg1 ri reg2)
1888 | not b && reg1 == g0
1889 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1891 RIReg rrr | rrr == reg2 -> empty
1894 = pprRegRIReg SLIT("or") b reg1 ri reg2
1896 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1898 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1899 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1901 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1902 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1903 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1905 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1906 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1907 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1909 pprInstr (SETHI imm reg)
1911 ptext SLIT("\tsethi\t"),
1917 pprInstr NOP = ptext SLIT("\tnop")
1919 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1920 pprInstr (FABS F64 reg1 reg2)
1921 = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1922 (if (reg1 == reg2) then empty
1923 else (<>) (char '\n')
1924 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1926 pprInstr (FADD size reg1 reg2 reg3)
1927 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1928 pprInstr (FCMP e size reg1 reg2)
1929 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1930 pprInstr (FDIV size reg1 reg2 reg3)
1931 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1933 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1934 pprInstr (FMOV F64 reg1 reg2)
1935 = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1936 (if (reg1 == reg2) then empty
1937 else (<>) (char '\n')
1938 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1940 pprInstr (FMUL size reg1 reg2 reg3)
1941 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1943 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1944 pprInstr (FNEG F64 reg1 reg2)
1945 = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1946 (if (reg1 == reg2) then empty
1947 else (<>) (char '\n')
1948 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1950 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1951 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1952 pprInstr (FxTOy size1 size2 reg1 reg2)
1959 F64 -> SLIT("dto")),
1964 F64 -> SLIT("d\t")),
1965 pprReg reg1, comma, pprReg reg2
1969 pprInstr (BI cond b lab)
1971 ptext SLIT("\tb"), pprCond cond,
1972 if b then pp_comma_a else empty,
1977 pprInstr (BF cond b lab)
1979 ptext SLIT("\tfb"), pprCond cond,
1980 if b then pp_comma_a else empty,
1985 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1987 pprInstr (CALL (Left imm) n _)
1988 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1989 pprInstr (CALL (Right reg) n _)
1990 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1993 pprRI (RIReg r) = pprReg r
1994 pprRI (RIImm r) = pprImm r
1996 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1997 pprSizeRegReg name size reg1 reg2
2002 F32 -> ptext SLIT("s\t")
2003 F64 -> ptext SLIT("d\t")),
2009 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
2010 pprSizeRegRegReg name size reg1 reg2 reg3
2015 F32 -> ptext SLIT("s\t")
2016 F64 -> ptext SLIT("d\t")),
2024 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2025 pprRegRIReg name b reg1 ri reg2
2029 if b then ptext SLIT("cc\t") else char '\t',
2037 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2038 pprRIReg name b ri reg1
2042 if b then ptext SLIT("cc\t") else char '\t',
2048 pp_ld_lbracket = ptext SLIT("\tld\t[")
2049 pp_rbracket_comma = text "],"
2050 pp_comma_lbracket = text ",["
2051 pp_comma_a = text ",a"
2053 #endif /* sparc_TARGET_ARCH */
2056 -- -----------------------------------------------------------------------------
2057 -- pprInstr for PowerPC
2059 #if powerpc_TARGET_ARCH
2060 pprInstr (LD sz reg addr) = hcat [
2069 case addr of AddrRegImm _ _ -> empty
2070 AddrRegReg _ _ -> char 'x',
2076 pprInstr (LA sz reg addr) = hcat [
2085 case addr of AddrRegImm _ _ -> empty
2086 AddrRegReg _ _ -> char 'x',
2092 pprInstr (ST sz reg addr) = hcat [
2096 case addr of AddrRegImm _ _ -> empty
2097 AddrRegReg _ _ -> char 'x',
2103 pprInstr (STU sz reg addr) = hcat [
2108 case addr of AddrRegImm _ _ -> empty
2109 AddrRegReg _ _ -> char 'x',
2114 pprInstr (LIS reg imm) = hcat [
2122 pprInstr (LI reg imm) = hcat [
2130 pprInstr (MR reg1 reg2)
2131 | reg1 == reg2 = empty
2132 | otherwise = hcat [
2134 case regClass reg1 of
2135 RcInteger -> ptext SLIT("mr")
2136 _ -> ptext SLIT("fmr"),
2142 pprInstr (CMP sz reg ri) = hcat [
2158 pprInstr (CMPL sz reg ri) = hcat [
2174 pprInstr (BCC cond (BlockId id)) = hcat [
2181 where lbl = mkAsmTempLabel id
2183 pprInstr (BCCFAR cond (BlockId id)) = vcat [
2186 pprCond (condNegate cond),
2190 ptext SLIT("\tb\t"),
2194 where lbl = mkAsmTempLabel id
2196 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2203 pprInstr (MTCTR reg) = hcat [
2205 ptext SLIT("mtctr"),
2209 pprInstr (BCTR _) = hcat [
2213 pprInstr (BL lbl _) = hcat [
2214 ptext SLIT("\tbl\t"),
2217 pprInstr (BCTRL _) = hcat [
2221 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2222 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2224 ptext SLIT("addis"),
2233 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2234 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2235 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2236 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2237 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2238 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2239 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2241 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2242 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2243 pprReg reg2, ptext SLIT(", "),
2245 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2246 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2247 pprReg reg1, ptext SLIT(", "),
2248 ptext SLIT("2, 31, 31") ]
2251 -- for some reason, "andi" doesn't exist.
2252 -- we'll use "andi." instead.
2253 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2255 ptext SLIT("andi."),
2263 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2265 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2266 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2268 pprInstr (XORIS reg1 reg2 imm) = hcat [
2270 ptext SLIT("xoris"),
2279 pprInstr (EXTS sz reg1 reg2) = hcat [
2289 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2290 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2292 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2293 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2294 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2295 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2296 ptext SLIT("\trlwinm\t"),
2308 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2309 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2310 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2311 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2312 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2314 pprInstr (FCMP reg1 reg2) = hcat [
2316 ptext SLIT("fcmpu\tcr0, "),
2317 -- Note: we're using fcmpu, not fcmpo
2318 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2319 -- We don't handle invalid fp ops, so we don't care
2325 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2326 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2328 pprInstr (CRNOR dst src1 src2) = hcat [
2329 ptext SLIT("\tcrnor\t"),
2337 pprInstr (MFCR reg) = hcat [
2344 pprInstr (MFLR reg) = hcat [
2351 pprInstr (FETCHPC reg) = vcat [
2352 ptext SLIT("\tbcl\t20,31,1f"),
2353 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2356 pprInstr LWSYNC = ptext SLIT("\tlwsync")
2358 pprInstr _ = panic "pprInstr (ppc)"
2360 pprLogic op reg1 reg2 ri = hcat [
2365 RIImm _ -> char 'i',
2374 pprUnary op reg1 reg2 = hcat [
2383 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2396 pprRI (RIReg r) = pprReg r
2397 pprRI (RIImm r) = pprImm r
2399 pprFSize F64 = empty
2400 pprFSize F32 = char 's'
2402 -- limit immediate argument for shift instruction to range 0..32
2403 -- (yes, the maximum is really 32, not 31)
2404 limitShiftRI :: RI -> RI
2405 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2408 #endif /* powerpc_TARGET_ARCH */
2411 -- -----------------------------------------------------------------------------
2412 -- Converting floating-point literals to integrals for printing
2414 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2415 castFloatToWord8Array = castSTUArray
2417 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2418 castDoubleToWord8Array = castSTUArray
2420 -- floatToBytes and doubleToBytes convert to the host's byte
2421 -- order. Providing that we're not cross-compiling for a
2422 -- target with the opposite endianness, this should work ok
2425 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2426 -- could they be merged?
2428 floatToBytes :: Float -> [Int]
2431 arr <- newArray_ ((0::Int),3)
2433 arr <- castFloatToWord8Array arr
2434 i0 <- readArray arr 0
2435 i1 <- readArray arr 1
2436 i2 <- readArray arr 2
2437 i3 <- readArray arr 3
2438 return (map fromIntegral [i0,i1,i2,i3])
2441 doubleToBytes :: Double -> [Int]
2444 arr <- newArray_ ((0::Int),7)
2446 arr <- castDoubleToWord8Array arr
2447 i0 <- readArray arr 0
2448 i1 <- readArray arr 1
2449 i2 <- readArray arr 2
2450 i3 <- readArray arr 3
2451 i4 <- readArray arr 4
2452 i5 <- readArray arr 5
2453 i6 <- readArray arr 6
2454 i7 <- readArray arr 7
2455 return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])