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,
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
41 import Data.Word ( Word8 )
42 import Control.Monad.ST
43 import Data.Char ( chr, ord )
44 import Data.Maybe ( isJust )
46 #if powerpc_TARGET_ARCH || darwin_TARGET_OS
47 import Data.Word(Word32)
51 -- -----------------------------------------------------------------------------
52 -- Printing this stuff out
54 asmSDoc d = Outputable.withPprStyleDoc (
55 Outputable.mkCodeStyle Outputable.AsmStyle) d
56 pprCLabel_asm l = asmSDoc (pprCLabel l)
58 pprNatCmmTop :: NatCmmTop -> Doc
59 pprNatCmmTop (CmmData section dats) =
60 pprSectionHeader section $$ vcat (map pprData dats)
62 -- special case for split markers:
63 pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
65 pprNatCmmTop (CmmProc info lbl params blocks) =
66 pprSectionHeader Text $$
69 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
70 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
73 vcat (map pprData info) $$
74 pprLabel (entryLblToInfoLbl lbl)
78 (BasicBlock _ instrs : rest) ->
79 (if null info then pprLabel lbl else empty) $$
80 -- the first block doesn't get a label:
81 vcat (map pprInstr instrs) $$
82 vcat (map pprBasicBlock rest)
84 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
85 -- If we are using the .subsections_via_symbols directive
86 -- (available on recent versions of Darwin),
87 -- we have to make sure that there is some kind of reference
88 -- from the entry code to a label on the _top_ of of the info table,
89 -- so that the linker will not think it is unreferenced and dead-strip
90 -- it. That's why the label is called a DeadStripPreventer (_dsp).
93 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
95 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
100 pprBasicBlock :: NatBasicBlock -> Doc
101 pprBasicBlock (BasicBlock (BlockId id) instrs) =
102 pprLabel (mkAsmTempLabel id) $$
103 vcat (map pprInstr instrs)
105 -- -----------------------------------------------------------------------------
106 -- pprReg: print a 'Reg'
108 -- For x86, the way we print a register name depends
109 -- on which bit of it we care about. Yurgh.
111 pprUserReg :: Reg -> Doc
112 pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
114 pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
116 pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
118 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i
119 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
120 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
121 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
122 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
124 #if alpha_TARGET_ARCH
125 ppr_reg_no :: Int -> Doc
128 0 -> SLIT("$0"); 1 -> SLIT("$1");
129 2 -> SLIT("$2"); 3 -> SLIT("$3");
130 4 -> SLIT("$4"); 5 -> SLIT("$5");
131 6 -> SLIT("$6"); 7 -> SLIT("$7");
132 8 -> SLIT("$8"); 9 -> SLIT("$9");
133 10 -> SLIT("$10"); 11 -> SLIT("$11");
134 12 -> SLIT("$12"); 13 -> SLIT("$13");
135 14 -> SLIT("$14"); 15 -> SLIT("$15");
136 16 -> SLIT("$16"); 17 -> SLIT("$17");
137 18 -> SLIT("$18"); 19 -> SLIT("$19");
138 20 -> SLIT("$20"); 21 -> SLIT("$21");
139 22 -> SLIT("$22"); 23 -> SLIT("$23");
140 24 -> SLIT("$24"); 25 -> SLIT("$25");
141 26 -> SLIT("$26"); 27 -> SLIT("$27");
142 28 -> SLIT("$28"); 29 -> SLIT("$29");
143 30 -> SLIT("$30"); 31 -> SLIT("$31");
144 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
145 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
146 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
147 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
148 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
149 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
150 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
151 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
152 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
153 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
154 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
155 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
156 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
157 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
158 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
159 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
160 _ -> SLIT("very naughty alpha register")
164 ppr_reg_no :: MachRep -> Int -> Doc
165 ppr_reg_no I8 = ppr_reg_byte
166 ppr_reg_no I16 = ppr_reg_word
167 ppr_reg_no _ = ppr_reg_long
169 ppr_reg_byte i = ptext
171 0 -> SLIT("%al"); 1 -> SLIT("%bl");
172 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
173 _ -> SLIT("very naughty I386 byte register")
176 ppr_reg_word i = ptext
178 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
179 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
180 4 -> SLIT("%si"); 5 -> SLIT("%di");
181 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
182 _ -> SLIT("very naughty I386 word register")
185 ppr_reg_long i = ptext
187 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
188 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
189 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
190 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
191 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
192 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
193 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
194 _ -> SLIT("very naughty I386 register")
198 #if x86_64_TARGET_ARCH
199 ppr_reg_no :: MachRep -> Int -> Doc
200 ppr_reg_no I8 = ppr_reg_byte
201 ppr_reg_no I16 = ppr_reg_word
202 ppr_reg_no I32 = ppr_reg_long
203 ppr_reg_no _ = ppr_reg_quad
205 ppr_reg_byte i = ptext
207 0 -> SLIT("%al"); 1 -> SLIT("%bl");
208 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
209 4 -> SLIT("%sil"); 5 -> SLIT("%dil"); -- new 8-bit regs!
210 6 -> SLIT("%bpl"); 7 -> SLIT("%spl");
211 8 -> SLIT("%r8b"); 9 -> SLIT("%r9b");
212 10 -> SLIT("%r10b"); 11 -> SLIT("%r11b");
213 12 -> SLIT("%r12b"); 13 -> SLIT("%r13b");
214 14 -> SLIT("%r14b"); 15 -> SLIT("%r15b");
215 _ -> SLIT("very naughty x86_64 byte register")
218 ppr_reg_word i = ptext
220 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
221 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
222 4 -> SLIT("%si"); 5 -> SLIT("%di");
223 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
224 8 -> SLIT("%r8w"); 9 -> SLIT("%r9w");
225 10 -> SLIT("%r10w"); 11 -> SLIT("%r11w");
226 12 -> SLIT("%r12w"); 13 -> SLIT("%r13w");
227 14 -> SLIT("%r14w"); 15 -> SLIT("%r15w");
228 _ -> SLIT("very naughty x86_64 word register")
231 ppr_reg_long i = ptext
233 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
234 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
235 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
236 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
237 8 -> SLIT("%r8d"); 9 -> SLIT("%r9d");
238 10 -> SLIT("%r10d"); 11 -> SLIT("%r11d");
239 12 -> SLIT("%r12d"); 13 -> SLIT("%r13d");
240 14 -> SLIT("%r14d"); 15 -> SLIT("%r15d");
241 _ -> SLIT("very naughty x86_64 register")
244 ppr_reg_quad i = ptext
246 0 -> SLIT("%rax"); 1 -> SLIT("%rbx");
247 2 -> SLIT("%rcx"); 3 -> SLIT("%rdx");
248 4 -> SLIT("%rsi"); 5 -> SLIT("%rdi");
249 6 -> SLIT("%rbp"); 7 -> SLIT("%rsp");
250 8 -> SLIT("%r8"); 9 -> SLIT("%r9");
251 10 -> SLIT("%r10"); 11 -> SLIT("%r11");
252 12 -> SLIT("%r12"); 13 -> SLIT("%r13");
253 14 -> SLIT("%r14"); 15 -> SLIT("%r15");
254 16 -> SLIT("%xmm0"); 17 -> SLIT("%xmm1");
255 18 -> SLIT("%xmm2"); 19 -> SLIT("%xmm3");
256 20 -> SLIT("%xmm4"); 21 -> SLIT("%xmm5");
257 22 -> SLIT("%xmm6"); 23 -> SLIT("%xmm7");
258 24 -> SLIT("%xmm8"); 25 -> SLIT("%xmm9");
259 26 -> SLIT("%xmm10"); 27 -> SLIT("%xmm11");
260 28 -> SLIT("%xmm12"); 29 -> SLIT("%xmm13");
261 30 -> SLIT("%xmm14"); 31 -> SLIT("%xmm15");
262 _ -> SLIT("very naughty x86_64 register")
266 #if sparc_TARGET_ARCH
267 ppr_reg_no :: Int -> Doc
270 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
271 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
272 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
273 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
274 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
275 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
276 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
277 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
278 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
279 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
280 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
281 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
282 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
283 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
284 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
285 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
286 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
287 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
288 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
289 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
290 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
291 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
292 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
293 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
294 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
295 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
296 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
297 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
298 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
299 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
300 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
301 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
302 _ -> SLIT("very naughty sparc register")
305 #if powerpc_TARGET_ARCH
307 ppr_reg_no :: Int -> Doc
310 0 -> SLIT("r0"); 1 -> SLIT("r1");
311 2 -> SLIT("r2"); 3 -> SLIT("r3");
312 4 -> SLIT("r4"); 5 -> SLIT("r5");
313 6 -> SLIT("r6"); 7 -> SLIT("r7");
314 8 -> SLIT("r8"); 9 -> SLIT("r9");
315 10 -> SLIT("r10"); 11 -> SLIT("r11");
316 12 -> SLIT("r12"); 13 -> SLIT("r13");
317 14 -> SLIT("r14"); 15 -> SLIT("r15");
318 16 -> SLIT("r16"); 17 -> SLIT("r17");
319 18 -> SLIT("r18"); 19 -> SLIT("r19");
320 20 -> SLIT("r20"); 21 -> SLIT("r21");
321 22 -> SLIT("r22"); 23 -> SLIT("r23");
322 24 -> SLIT("r24"); 25 -> SLIT("r25");
323 26 -> SLIT("r26"); 27 -> SLIT("r27");
324 28 -> SLIT("r28"); 29 -> SLIT("r29");
325 30 -> SLIT("r30"); 31 -> SLIT("r31");
326 32 -> SLIT("f0"); 33 -> SLIT("f1");
327 34 -> SLIT("f2"); 35 -> SLIT("f3");
328 36 -> SLIT("f4"); 37 -> SLIT("f5");
329 38 -> SLIT("f6"); 39 -> SLIT("f7");
330 40 -> SLIT("f8"); 41 -> SLIT("f9");
331 42 -> SLIT("f10"); 43 -> SLIT("f11");
332 44 -> SLIT("f12"); 45 -> SLIT("f13");
333 46 -> SLIT("f14"); 47 -> SLIT("f15");
334 48 -> SLIT("f16"); 49 -> SLIT("f17");
335 50 -> SLIT("f18"); 51 -> SLIT("f19");
336 52 -> SLIT("f20"); 53 -> SLIT("f21");
337 54 -> SLIT("f22"); 55 -> SLIT("f23");
338 56 -> SLIT("f24"); 57 -> SLIT("f25");
339 58 -> SLIT("f26"); 59 -> SLIT("f27");
340 60 -> SLIT("f28"); 61 -> SLIT("f29");
341 62 -> SLIT("f30"); 63 -> SLIT("f31");
342 _ -> SLIT("very naughty powerpc register")
345 ppr_reg_no :: Int -> Doc
346 ppr_reg_no i | i <= 31 = int i -- GPRs
347 | i <= 63 = int (i-32) -- FPRs
348 | otherwise = ptext SLIT("very naughty powerpc register")
353 -- -----------------------------------------------------------------------------
354 -- pprSize: print a 'Size'
356 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
357 pprSize :: MachRep -> Doc
359 pprSize :: Size -> Doc
362 pprSize x = ptext (case x of
363 #if alpha_TARGET_ARCH
366 -- W -> SLIT("w") UNUSED
367 -- Wu -> SLIT("wu") UNUSED
370 -- FF -> SLIT("f") UNUSED
371 -- DF -> SLIT("d") UNUSED
372 -- GF -> SLIT("g") UNUSED
373 -- SF -> SLIT("s") UNUSED
376 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
387 #if x86_64_TARGET_ARCH
388 F32 -> SLIT("ss") -- "scalar single-precision float" (SSE2)
389 F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2)
391 #if sparc_TARGET_ARCH
398 pprStSize :: MachRep -> Doc
399 pprStSize x = ptext (case x of
406 #if powerpc_TARGET_ARCH
415 -- -----------------------------------------------------------------------------
416 -- pprCond: print a 'Cond'
418 pprCond :: Cond -> Doc
420 pprCond c = ptext (case c of {
421 #if alpha_TARGET_ARCH
431 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
432 GEU -> SLIT("ae"); LU -> SLIT("b");
433 EQQ -> SLIT("e"); GTT -> SLIT("g");
434 GE -> SLIT("ge"); GU -> SLIT("a");
435 LTT -> SLIT("l"); LE -> SLIT("le");
436 LEU -> SLIT("be"); NE -> SLIT("ne");
437 NEG -> SLIT("s"); POS -> SLIT("ns");
438 CARRY -> SLIT("c"); OFLO -> SLIT("o");
439 PARITY -> SLIT("p"); NOTPARITY -> SLIT("np");
440 ALWAYS -> SLIT("mp") -- hack
442 #if sparc_TARGET_ARCH
443 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
444 GEU -> SLIT("geu"); LU -> SLIT("lu");
445 EQQ -> SLIT("e"); GTT -> SLIT("g");
446 GE -> SLIT("ge"); GU -> SLIT("gu");
447 LTT -> SLIT("l"); LE -> SLIT("le");
448 LEU -> SLIT("leu"); NE -> SLIT("ne");
449 NEG -> SLIT("neg"); POS -> SLIT("pos");
450 VC -> SLIT("vc"); VS -> SLIT("vs")
452 #if powerpc_TARGET_ARCH
454 EQQ -> SLIT("eq"); NE -> SLIT("ne");
455 LTT -> SLIT("lt"); GE -> SLIT("ge");
456 GTT -> SLIT("gt"); LE -> SLIT("le");
457 LU -> SLIT("lt"); GEU -> SLIT("ge");
458 GU -> SLIT("gt"); LEU -> SLIT("le");
463 -- -----------------------------------------------------------------------------
464 -- pprImm: print an 'Imm'
468 pprImm (ImmInt i) = int i
469 pprImm (ImmInteger i) = integer i
470 pprImm (ImmCLbl l) = pprCLabel_asm l
471 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
472 pprImm (ImmLit s) = s
474 pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
475 pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
477 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
478 #if sparc_TARGET_ARCH
479 -- ToDo: This should really be fixed in the PIC support, but only
481 pprImm (ImmConstantDiff a b) = pprImm a
483 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
484 <> lparen <> pprImm b <> rparen
487 #if sparc_TARGET_ARCH
489 = hcat [ pp_lo, pprImm i, rparen ]
494 = hcat [ pp_hi, pprImm i, rparen ]
498 #if powerpc_TARGET_ARCH
501 = hcat [ pp_lo, pprImm i, rparen ]
506 = hcat [ pp_hi, pprImm i, rparen ]
511 = hcat [ pp_ha, pprImm i, rparen ]
517 = pprImm i <> text "@l"
520 = pprImm i <> text "@h"
523 = pprImm i <> text "@ha"
528 -- -----------------------------------------------------------------------------
529 -- @pprAddr: print an 'AddrMode'
531 pprAddr :: AddrMode -> Doc
533 #if alpha_TARGET_ARCH
534 pprAddr (AddrReg r) = parens (pprReg r)
535 pprAddr (AddrImm i) = pprImm i
536 pprAddr (AddrRegImm r1 i)
537 = (<>) (pprImm i) (parens (pprReg r1))
542 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
543 pprAddr (ImmAddr imm off)
544 = let pp_imm = pprImm imm
548 else if (off < 0) then
551 pp_imm <> char '+' <> int off
553 pprAddr (AddrBaseIndex base index displacement)
555 pp_disp = ppr_disp displacement
556 pp_off p = pp_disp <> char '(' <> p <> char ')'
557 pp_reg r = pprReg wordRep r
560 (EABaseNone, EAIndexNone) -> pp_disp
561 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
562 (EABaseRip, EAIndexNone) -> pp_off (ptext SLIT("%rip"))
563 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
564 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
567 ppr_disp (ImmInt 0) = empty
568 ppr_disp imm = pprImm imm
573 #if sparc_TARGET_ARCH
574 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
576 pprAddr (AddrRegReg r1 r2)
577 = hcat [ pprReg r1, char '+', pprReg r2 ]
579 pprAddr (AddrRegImm r1 (ImmInt i))
581 | not (fits13Bits i) = largeOffsetError i
582 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
584 pp_sign = if i > 0 then char '+' else empty
586 pprAddr (AddrRegImm r1 (ImmInteger i))
588 | not (fits13Bits i) = largeOffsetError i
589 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
591 pp_sign = if i > 0 then char '+' else empty
593 pprAddr (AddrRegImm r1 imm)
594 = hcat [ pprReg r1, char '+', pprImm imm ]
599 #if powerpc_TARGET_ARCH
600 pprAddr (AddrRegReg r1 r2)
601 = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
603 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
604 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
605 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
609 -- -----------------------------------------------------------------------------
610 -- pprData: print a 'CmmStatic'
612 pprSectionHeader Text
614 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
615 ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
616 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".text\n\t.align 2"),
617 SLIT(".text\n\t.align 4,0x90"))
618 {-needs per-OS variation!-}
619 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".text\n.align 3"),
620 SLIT(".text\n\t.align 8"))
621 ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
623 pprSectionHeader Data
625 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
626 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
627 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
628 SLIT(".data\n\t.align 4"))
629 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n.align 3"),
630 SLIT(".data\n\t.align 8"))
631 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
633 pprSectionHeader ReadOnlyData
635 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
636 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
637 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"),
638 SLIT(".section .rodata\n\t.align 4"))
639 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 3"),
640 SLIT(".section .rodata\n\t.align 8"))
641 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
642 SLIT(".section .rodata\n\t.align 2"))
644 pprSectionHeader RelocatableReadOnlyData
646 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
647 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
648 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
649 SLIT(".section .data\n\t.align 4"))
650 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const_data\n.align 3"),
651 SLIT(".section .data\n\t.align 8"))
652 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
653 SLIT(".data\n\t.align 2"))
655 pprSectionHeader UninitialisedData
657 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
658 ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
659 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
660 SLIT(".section .bss\n\t.align 4"))
661 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".data\n\t.align 3"),
662 SLIT(".section .bss\n\t.align 8"))
663 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
664 SLIT(".section .bss\n\t.align 2"))
666 pprSectionHeader ReadOnlyData16
668 IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
669 ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
670 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 4"),
671 SLIT(".section .rodata\n\t.align 16"))
672 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const\n.align 4"),
673 SLIT(".section .rodata.cst16\n\t.align 16"))
674 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
675 SLIT(".section .rodata\n\t.align 4"))
678 pprSectionHeader (OtherSection sec)
679 = panic "PprMach.pprSectionHeader: unknown section"
681 pprData :: CmmStatic -> Doc
682 pprData (CmmAlign bytes) = pprAlign bytes
683 pprData (CmmDataLabel lbl) = pprLabel lbl
684 pprData (CmmString str) = pprASCII str
685 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
686 pprData (CmmStaticLit lit) = pprDataItem lit
688 pprGloblDecl :: CLabel -> Doc
690 | not (externallyVisibleCLabel lbl) = empty
691 | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
695 pprTypeAndSizeDecl :: CLabel -> Doc
696 pprTypeAndSizeDecl lbl
697 | not (externallyVisibleCLabel lbl) = empty
698 | otherwise = ptext SLIT(".type ") <>
699 pprCLabel_asm lbl <> ptext SLIT(", @object")
701 pprLabel :: CLabel -> Doc
702 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
706 = vcat (map do1 str) $$ do1 0
709 do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
712 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
713 IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
714 IF_ARCH_x86_64(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
715 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
716 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
720 log2 :: Int -> Int -- cache the common ones
725 log2 n = 1 + log2 (n `quot` 2)
728 pprDataItem :: CmmLit -> Doc
730 = vcat (ppr_item (cmmLitRep lit) lit)
734 -- These seem to be common:
735 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
736 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
737 ppr_item F32 (CmmFloat r _)
738 = let bs = floatToBytes (fromRational r)
739 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
740 ppr_item F64 (CmmFloat r _)
741 = let bs = doubleToBytes (fromRational r)
742 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
744 #if sparc_TARGET_ARCH
745 -- copy n paste of x86 version
746 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
747 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
749 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
750 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
752 #if i386_TARGET_ARCH && darwin_TARGET_OS
753 ppr_item I64 (CmmInt x _) =
754 [ptext SLIT("\t.long\t")
755 <> int (fromIntegral (fromIntegral x :: Word32)),
756 ptext SLIT("\t.long\t")
758 (fromIntegral (x `shiftR` 32) :: Word32))]
760 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
761 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
763 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
764 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
765 -- type, which means we can't do pc-relative 64-bit addresses.
766 -- Fortunately we're assuming the small memory model, in which
767 -- all such offsets will fit into 32 bits, so we have to stick
768 -- to 32-bit offset fields and modify the RTS appropriately
770 -- See Note [x86-64-relative] in includes/InfoTables.h
773 | isRelativeReloc x =
774 [ptext SLIT("\t.long\t") <> pprImm imm,
775 ptext SLIT("\t.long\t0")]
777 [ptext SLIT("\t.quad\t") <> pprImm imm]
779 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
780 isRelativeReloc _ = False
782 #if powerpc_TARGET_ARCH
783 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
784 ppr_item I64 (CmmInt x _) =
785 [ptext SLIT("\t.long\t")
787 (fromIntegral (x `shiftR` 32) :: Word32)),
788 ptext SLIT("\t.long\t")
789 <> int (fromIntegral (fromIntegral x :: Word32))]
792 -- fall through to rest of (machine-specific) pprInstr...
794 -- -----------------------------------------------------------------------------
795 -- pprInstr: print an 'Instr'
797 pprInstr :: Instr -> Doc
799 --pprInstr (COMMENT s) = empty -- nuke 'em
801 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
802 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
803 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
804 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
805 ,IF_ARCH_powerpc( IF_OS_linux(
806 ((<>) (ptext SLIT("# ")) (ftext s)),
807 ((<>) (ptext SLIT("; ")) (ftext s)))
811 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
813 pprInstr (NEWBLOCK _)
814 = panic "PprMach.pprInstr: NEWBLOCK"
817 = panic "PprMach.pprInstr: LDATA"
819 -- -----------------------------------------------------------------------------
820 -- pprInstr for an Alpha
822 #if alpha_TARGET_ARCH
824 pprInstr (LD size reg addr)
834 pprInstr (LDA reg addr)
836 ptext SLIT("\tlda\t"),
842 pprInstr (LDAH reg addr)
844 ptext SLIT("\tldah\t"),
850 pprInstr (LDGP reg addr)
852 ptext SLIT("\tldgp\t"),
858 pprInstr (LDI size reg imm)
868 pprInstr (ST size reg addr)
880 ptext SLIT("\tclr\t"),
884 pprInstr (ABS size ri reg)
894 pprInstr (NEG size ov ri reg)
898 if ov then ptext SLIT("v\t") else char '\t',
904 pprInstr (ADD size ov reg1 ri reg2)
908 if ov then ptext SLIT("v\t") else char '\t',
916 pprInstr (SADD size scale reg1 ri reg2)
918 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
929 pprInstr (SUB size ov reg1 ri reg2)
933 if ov then ptext SLIT("v\t") else char '\t',
941 pprInstr (SSUB size scale reg1 ri reg2)
943 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
954 pprInstr (MUL size ov reg1 ri reg2)
958 if ov then ptext SLIT("v\t") else char '\t',
966 pprInstr (DIV size uns reg1 ri reg2)
970 if uns then ptext SLIT("u\t") else char '\t',
978 pprInstr (REM size uns reg1 ri reg2)
982 if uns then ptext SLIT("u\t") else char '\t',
990 pprInstr (NOT ri reg)
999 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
1000 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
1001 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
1002 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
1003 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
1004 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
1006 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
1007 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
1008 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
1010 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
1011 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
1013 pprInstr (NOP) = ptext SLIT("\tnop")
1015 pprInstr (CMP cond reg1 ri reg2)
1017 ptext SLIT("\tcmp"),
1029 ptext SLIT("\tfclr\t"),
1033 pprInstr (FABS reg1 reg2)
1035 ptext SLIT("\tfabs\t"),
1041 pprInstr (FNEG size reg1 reg2)
1043 ptext SLIT("\tneg"),
1051 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1052 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1053 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1054 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1056 pprInstr (CVTxy size1 size2 reg1 reg2)
1058 ptext SLIT("\tcvt"),
1060 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1067 pprInstr (FCMP size cond reg1 reg2 reg3)
1069 ptext SLIT("\tcmp"),
1080 pprInstr (FMOV reg1 reg2)
1082 ptext SLIT("\tfmov\t"),
1088 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1090 pprInstr (BI NEVER reg lab) = empty
1092 pprInstr (BI cond reg lab)
1102 pprInstr (BF cond reg lab)
1113 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1115 pprInstr (JMP reg addr hint)
1117 ptext SLIT("\tjmp\t"),
1125 pprInstr (BSR imm n)
1126 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1128 pprInstr (JSR reg addr n)
1130 ptext SLIT("\tjsr\t"),
1136 pprInstr (FUNBEGIN clab)
1138 if (externallyVisibleCLabel clab) then
1139 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1142 ptext SLIT("\t.ent "),
1151 pp_lab = pprCLabel_asm clab
1153 -- NEVER use commas within those string literals, cpp will ruin your day
1154 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1155 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1156 ptext SLIT("4240"), char ',',
1157 ptext SLIT("$26"), char ',',
1158 ptext SLIT("0\n\t.prologue 1") ]
1160 pprInstr (FUNEND clab)
1161 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1164 Continue with Alpha-only printing bits and bobs:
1168 pprRI (RIReg r) = pprReg r
1169 pprRI (RIImm r) = pprImm r
1171 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1172 pprRegRIReg name reg1 ri reg2
1184 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1185 pprSizeRegRegReg name size reg1 reg2 reg3
1198 #endif /* alpha_TARGET_ARCH */
1201 -- -----------------------------------------------------------------------------
1202 -- pprInstr for an x86
1204 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1206 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1209 #if 0 /* #ifdef DEBUG */
1210 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1215 pprInstr (MOV size src dst)
1216 = pprSizeOpOp SLIT("mov") size src dst
1218 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1219 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1220 -- movl. But we represent it as a MOVZxL instruction, because
1221 -- the reg alloc would tend to throw away a plain reg-to-reg
1222 -- move, and we still want it to do that.
1224 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1225 -- zero-extension only needs to extend to 32 bits: on x86_64,
1226 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1227 -- instruction is shorter.
1229 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1231 -- here we do some patching, since the physical registers are only set late
1232 -- in the code generation.
1233 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1235 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1236 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1238 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1239 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1241 = pprInstr (ADD size (OpImm displ) dst)
1242 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1244 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1245 = pprSizeOp SLIT("dec") size dst
1246 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1247 = pprSizeOp SLIT("inc") size dst
1248 pprInstr (ADD size src dst)
1249 = pprSizeOpOp SLIT("add") size src dst
1250 pprInstr (ADC size src dst)
1251 = pprSizeOpOp SLIT("adc") size src dst
1252 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1253 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1255 {- A hack. The Intel documentation says that "The two and three
1256 operand forms [of IMUL] may also be used with unsigned operands
1257 because the lower half of the product is the same regardless if
1258 (sic) the operands are signed or unsigned. The CF and OF flags,
1259 however, cannot be used to determine if the upper half of the
1260 result is non-zero." So there.
1262 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1263 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1265 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1266 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1267 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1269 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1270 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1272 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1273 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1274 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1276 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1278 pprInstr (CMP size src dst)
1279 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1280 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1282 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1283 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1284 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1286 -- both unused (SDM):
1287 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1288 -- pprInstr POPA = ptext SLIT("\tpopal")
1290 pprInstr NOP = ptext SLIT("\tnop")
1291 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1292 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1294 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1296 pprInstr (JXX cond (BlockId id))
1297 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1298 where lab = mkAsmTempLabel id
1300 pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
1302 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1303 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1304 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1305 pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1306 pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1308 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1309 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1310 pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
1312 #if x86_64_TARGET_ARCH
1313 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1315 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1317 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1318 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1319 pprInstr (CVTTSS2SIQ from to) = pprOpReg SLIT("cvttss2siq") from to
1320 pprInstr (CVTTSD2SIQ from to) = pprOpReg SLIT("cvttsd2siq") from to
1321 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ssq") from to
1322 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sdq") from to
1325 -- FETCHGOT for PIC on ELF platforms
1326 pprInstr (FETCHGOT reg)
1327 = vcat [ ptext SLIT("\tcall 1f"),
1328 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1329 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1333 -- FETCHPC for PIC on Darwin/x86
1334 -- get the instruction pointer into a register
1335 -- (Terminology note: the IP is called Program Counter on PPC,
1336 -- and it's a good thing to use the same name on both platforms)
1337 pprInstr (FETCHPC reg)
1338 = vcat [ ptext SLIT("\tcall 1f"),
1339 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1346 -- -----------------------------------------------------------------------------
1347 -- i386 floating-point
1349 #if i386_TARGET_ARCH
1350 -- Simulating a flat register set on the x86 FP stack is tricky.
1351 -- you have to free %st(7) before pushing anything on the FP reg stack
1352 -- so as to preclude the possibility of a FP stack overflow exception.
1353 pprInstr g@(GMOV src dst)
1357 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1359 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1360 pprInstr g@(GLD sz addr dst)
1361 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1362 pprAddr addr, gsemi, gpop dst 1])
1364 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1365 pprInstr g@(GST sz src addr)
1366 = pprG g (hcat [gtab, gpush src 0, gsemi,
1367 text "fstp", pprSize sz, gsp, pprAddr addr])
1369 pprInstr g@(GLDZ dst)
1370 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1371 pprInstr g@(GLD1 dst)
1372 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1374 pprInstr g@(GFTOI src dst)
1375 = pprInstr (GDTOI src dst)
1376 pprInstr g@(GDTOI src dst)
1377 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1378 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1381 pprInstr g@(GITOF src dst)
1382 = pprInstr (GITOD src dst)
1383 pprInstr g@(GITOD src dst)
1384 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1385 text " ; ffree %st(7); fildl (%esp) ; ",
1386 gpop dst 1, text " ; addl $4,%esp"])
1388 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1389 this far into the jungle AND you give a Rat's Ass (tm) what's going
1390 on, here's the deal. Generate code to do a floating point comparison
1391 of src1 and src2, of kind cond, and set the Zero flag if true.
1393 The complications are to do with handling NaNs correctly. We want the
1394 property that if either argument is NaN, then the result of the
1395 comparison is False ... except if we're comparing for inequality,
1396 in which case the answer is True.
1398 Here's how the general (non-inequality) case works. As an
1399 example, consider generating the an equality test:
1401 pushl %eax -- we need to mess with this
1402 <get src1 to top of FPU stack>
1403 fcomp <src2 location in FPU stack> and pop pushed src1
1404 -- Result of comparison is in FPU Status Register bits
1406 fstsw %ax -- Move FPU Status Reg to %ax
1407 sahf -- move C3 C2 C0 from %ax to integer flag reg
1408 -- now the serious magic begins
1409 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1410 sete %al -- %al = if arg1 == arg2 then 1 else 0
1411 andb %ah,%al -- %al &= %ah
1412 -- so %al == 1 iff (comparable && same); else it holds 0
1413 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1414 else %al == 0xFF, ZeroFlag=0
1415 -- the zero flag is now set as we desire.
1418 The special case of inequality differs thusly:
1420 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1421 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1422 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1423 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1424 else (%al == 0xFF, ZF=0)
1426 pprInstr g@(GCMP cond src1 src2)
1427 | case cond of { NE -> True; other -> False }
1429 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1430 hcat [gtab, text "fcomp ", greg src2 1,
1431 text "; fstsw %ax ; sahf ; setpe %ah"],
1432 hcat [gtab, text "setne %al ; ",
1433 text "orb %ah,%al ; decb %al ; popl %eax"]
1437 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1438 hcat [gtab, text "fcomp ", greg src2 1,
1439 text "; fstsw %ax ; sahf ; setpo %ah"],
1440 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1441 text "andb %ah,%al ; decb %al ; popl %eax"]
1444 {- On the 486, the flags set by FP compare are the unsigned ones!
1445 (This looks like a HACK to me. WDP 96/03)
1447 fix_FP_cond :: Cond -> Cond
1448 fix_FP_cond GE = GEU
1449 fix_FP_cond GTT = GU
1450 fix_FP_cond LTT = LU
1451 fix_FP_cond LE = LEU
1452 fix_FP_cond EQQ = EQQ
1454 -- there should be no others
1457 pprInstr g@(GABS sz src dst)
1458 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1459 pprInstr g@(GNEG sz src dst)
1460 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1462 pprInstr g@(GSQRT sz src dst)
1463 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1464 hcat [gtab, gcoerceto sz, gpop dst 1])
1465 pprInstr g@(GSIN sz src dst)
1466 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1467 hcat [gtab, gcoerceto sz, gpop dst 1])
1468 pprInstr g@(GCOS sz src dst)
1469 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1470 hcat [gtab, gcoerceto sz, gpop dst 1])
1471 pprInstr g@(GTAN sz src dst)
1472 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1473 gpush src 0, text " ; fptan ; ",
1474 text " fstp %st(0)"] $$
1475 hcat [gtab, gcoerceto sz, gpop dst 1])
1477 -- In the translations for GADD, GMUL, GSUB and GDIV,
1478 -- the first two cases are mere optimisations. The otherwise clause
1479 -- generates correct code under all circumstances.
1481 pprInstr g@(GADD sz src1 src2 dst)
1483 = pprG g (text "\t#GADD-xxxcase1" $$
1484 hcat [gtab, gpush src2 0,
1485 text " ; faddp %st(0),", greg src1 1])
1487 = pprG g (text "\t#GADD-xxxcase2" $$
1488 hcat [gtab, gpush src1 0,
1489 text " ; faddp %st(0),", greg src2 1])
1491 = pprG g (hcat [gtab, gpush src1 0,
1492 text " ; fadd ", greg src2 1, text ",%st(0)",
1496 pprInstr g@(GMUL sz src1 src2 dst)
1498 = pprG g (text "\t#GMUL-xxxcase1" $$
1499 hcat [gtab, gpush src2 0,
1500 text " ; fmulp %st(0),", greg src1 1])
1502 = pprG g (text "\t#GMUL-xxxcase2" $$
1503 hcat [gtab, gpush src1 0,
1504 text " ; fmulp %st(0),", greg src2 1])
1506 = pprG g (hcat [gtab, gpush src1 0,
1507 text " ; fmul ", greg src2 1, text ",%st(0)",
1511 pprInstr g@(GSUB sz src1 src2 dst)
1513 = pprG g (text "\t#GSUB-xxxcase1" $$
1514 hcat [gtab, gpush src2 0,
1515 text " ; fsubrp %st(0),", greg src1 1])
1517 = pprG g (text "\t#GSUB-xxxcase2" $$
1518 hcat [gtab, gpush src1 0,
1519 text " ; fsubp %st(0),", greg src2 1])
1521 = pprG g (hcat [gtab, gpush src1 0,
1522 text " ; fsub ", greg src2 1, text ",%st(0)",
1526 pprInstr g@(GDIV sz src1 src2 dst)
1528 = pprG g (text "\t#GDIV-xxxcase1" $$
1529 hcat [gtab, gpush src2 0,
1530 text " ; fdivrp %st(0),", greg src1 1])
1532 = pprG g (text "\t#GDIV-xxxcase2" $$
1533 hcat [gtab, gpush src1 0,
1534 text " ; fdivp %st(0),", greg src2 1])
1536 = pprG g (hcat [gtab, gpush src1 0,
1537 text " ; fdiv ", greg src2 1, text ",%st(0)",
1542 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1543 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1546 --------------------------
1548 -- coerce %st(0) to the specified size
1549 gcoerceto F64 = empty
1550 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1553 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1555 = hcat [text "fstp ", greg reg offset]
1557 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1562 gregno (RealReg i) = i
1563 gregno other = --pprPanic "gregno" (ppr other)
1564 999 -- bogus; only needed for debug printing
1566 pprG :: Instr -> Doc -> Doc
1568 = (char '#' <> pprGInstr fake) $$ actual
1570 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1571 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1572 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1574 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1575 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1577 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1578 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1580 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1581 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1583 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1584 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1585 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1586 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1587 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1588 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1589 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1591 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1592 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1593 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1594 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1597 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1599 -- Continue with I386-only printing bits and bobs:
1601 pprDollImm :: Imm -> Doc
1603 pprDollImm i = ptext SLIT("$") <> pprImm i
1605 pprOperand :: MachRep -> Operand -> Doc
1606 pprOperand s (OpReg r) = pprReg s r
1607 pprOperand s (OpImm i) = pprDollImm i
1608 pprOperand s (OpAddr ea) = pprAddr ea
1610 pprMnemonic_ :: LitString -> Doc
1612 char '\t' <> ptext name <> space
1614 pprMnemonic :: LitString -> MachRep -> Doc
1615 pprMnemonic name size =
1616 char '\t' <> ptext name <> pprSize size <> space
1618 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1619 pprSizeImmOp name size imm op1
1621 pprMnemonic name size,
1628 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1629 pprSizeOp name size op1
1631 pprMnemonic name size,
1635 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1636 pprSizeOpOp name size op1 op2
1638 pprMnemonic name size,
1639 pprOperand size op1,
1644 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1645 pprOpOp name size op1 op2
1648 pprOperand size op1,
1653 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1654 pprSizeReg name size reg1
1656 pprMnemonic name size,
1660 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1661 pprSizeRegReg name size reg1 reg2
1663 pprMnemonic name size,
1669 pprRegReg :: LitString -> Reg -> Reg -> Doc
1670 pprRegReg name reg1 reg2
1673 pprReg wordRep reg1,
1678 pprOpReg :: LitString -> Operand -> Reg -> Doc
1679 pprOpReg name op1 reg2
1682 pprOperand wordRep op1,
1687 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1688 pprCondRegReg name size cond reg1 reg2
1699 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1700 pprSizeSizeRegReg name size1 size2 reg1 reg2
1713 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1714 pprSizeRegRegReg name size reg1 reg2 reg3
1716 pprMnemonic name size,
1724 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1725 pprSizeAddrReg name size op dst
1727 pprMnemonic name size,
1733 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1734 pprSizeRegAddr name size src op
1736 pprMnemonic name size,
1742 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1743 pprShift name size src dest
1745 pprMnemonic name size,
1746 pprOperand I8 src, -- src is 8-bit sized
1748 pprOperand size dest
1751 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1752 pprSizeOpOpCoerce name size1 size2 op1 op2
1753 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1754 pprOperand size1 op1,
1756 pprOperand size2 op2
1759 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1760 pprCondInstr name cond arg
1761 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1763 #endif /* i386_TARGET_ARCH */
1766 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1768 #if sparc_TARGET_ARCH
1770 -- a clumsy hack for now, to handle possible double alignment problems
1772 -- even clumsier, to allow for RegReg regs that show when doing indexed
1773 -- reads (bytearrays).
1776 -- Translate to the following:
1779 -- ld [g1+4],%f(n+1)
1780 -- sub g1,g2,g1 -- to restore g1
1782 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1784 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1785 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1786 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1787 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1792 -- ld [addr+4],%f(n+1)
1793 pprInstr (LD F64 addr reg) | isJust off_addr
1795 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1796 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1799 off_addr = addrOffset addr 4
1800 addr2 = case off_addr of Just x -> x
1803 pprInstr (LD size addr reg)
1814 -- The same clumsy hack as above
1816 -- Translate to the following:
1819 -- st %f(n+1),[g1+4]
1820 -- sub g1,g2,g1 -- to restore g1
1821 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1823 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1824 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1826 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1827 pprReg g1, ptext SLIT("+4]")],
1828 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1833 -- st %f(n+1),[addr+4]
1834 pprInstr (ST F64 reg addr) | isJust off_addr
1836 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1837 pprAddr addr, rbrack],
1838 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1839 pprAddr addr2, rbrack]
1842 off_addr = addrOffset addr 4
1843 addr2 = case off_addr of Just x -> x
1845 -- no distinction is made between signed and unsigned bytes on stores for the
1846 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1847 -- so we call a special-purpose pprSize for ST..
1849 pprInstr (ST size reg addr)
1860 pprInstr (ADD x cc reg1 ri reg2)
1861 | not x && not cc && riZero ri
1862 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1864 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1866 pprInstr (SUB x cc reg1 ri reg2)
1867 | not x && cc && reg2 == g0
1868 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1869 | not x && not cc && riZero ri
1870 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1872 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1874 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1875 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1877 pprInstr (OR b reg1 ri reg2)
1878 | not b && reg1 == g0
1879 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1881 RIReg rrr | rrr == reg2 -> empty
1884 = pprRegRIReg SLIT("or") b reg1 ri reg2
1886 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1888 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1889 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1891 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1892 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1893 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1895 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1896 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1897 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1899 pprInstr (SETHI imm reg)
1901 ptext SLIT("\tsethi\t"),
1907 pprInstr NOP = ptext SLIT("\tnop")
1909 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1910 pprInstr (FABS F64 reg1 reg2)
1911 = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1912 (if (reg1 == reg2) then empty
1913 else (<>) (char '\n')
1914 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1916 pprInstr (FADD size reg1 reg2 reg3)
1917 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1918 pprInstr (FCMP e size reg1 reg2)
1919 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1920 pprInstr (FDIV size reg1 reg2 reg3)
1921 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1923 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1924 pprInstr (FMOV F64 reg1 reg2)
1925 = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1926 (if (reg1 == reg2) then empty
1927 else (<>) (char '\n')
1928 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1930 pprInstr (FMUL size reg1 reg2 reg3)
1931 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1933 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1934 pprInstr (FNEG F64 reg1 reg2)
1935 = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1936 (if (reg1 == reg2) then empty
1937 else (<>) (char '\n')
1938 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1940 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1941 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1942 pprInstr (FxTOy size1 size2 reg1 reg2)
1949 F64 -> SLIT("dto")),
1954 F64 -> SLIT("d\t")),
1955 pprReg reg1, comma, pprReg reg2
1959 pprInstr (BI cond b lab)
1961 ptext SLIT("\tb"), pprCond cond,
1962 if b then pp_comma_a else empty,
1967 pprInstr (BF cond b lab)
1969 ptext SLIT("\tfb"), pprCond cond,
1970 if b then pp_comma_a else empty,
1975 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1977 pprInstr (CALL (Left imm) n _)
1978 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1979 pprInstr (CALL (Right reg) n _)
1980 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1983 pprRI (RIReg r) = pprReg r
1984 pprRI (RIImm r) = pprImm r
1986 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1987 pprSizeRegReg name size reg1 reg2
1992 F32 -> ptext SLIT("s\t")
1993 F64 -> ptext SLIT("d\t")),
1999 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
2000 pprSizeRegRegReg name size reg1 reg2 reg3
2005 F32 -> ptext SLIT("s\t")
2006 F64 -> ptext SLIT("d\t")),
2014 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2015 pprRegRIReg name b reg1 ri reg2
2019 if b then ptext SLIT("cc\t") else char '\t',
2027 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2028 pprRIReg name b ri reg1
2032 if b then ptext SLIT("cc\t") else char '\t',
2038 pp_ld_lbracket = ptext SLIT("\tld\t[")
2039 pp_rbracket_comma = text "],"
2040 pp_comma_lbracket = text ",["
2041 pp_comma_a = text ",a"
2043 #endif /* sparc_TARGET_ARCH */
2046 -- -----------------------------------------------------------------------------
2047 -- pprInstr for PowerPC
2049 #if powerpc_TARGET_ARCH
2050 pprInstr (LD sz reg addr) = hcat [
2059 case addr of AddrRegImm _ _ -> empty
2060 AddrRegReg _ _ -> char 'x',
2066 pprInstr (LA sz reg addr) = hcat [
2075 case addr of AddrRegImm _ _ -> empty
2076 AddrRegReg _ _ -> char 'x',
2082 pprInstr (ST sz reg addr) = hcat [
2086 case addr of AddrRegImm _ _ -> empty
2087 AddrRegReg _ _ -> char 'x',
2093 pprInstr (STU sz reg addr) = hcat [
2098 case addr of AddrRegImm _ _ -> empty
2099 AddrRegReg _ _ -> char 'x',
2104 pprInstr (LIS reg imm) = hcat [
2112 pprInstr (LI reg imm) = hcat [
2120 pprInstr (MR reg1 reg2)
2121 | reg1 == reg2 = empty
2122 | otherwise = hcat [
2124 case regClass reg1 of
2125 RcInteger -> ptext SLIT("mr")
2126 _ -> ptext SLIT("fmr"),
2132 pprInstr (CMP sz reg ri) = hcat [
2148 pprInstr (CMPL sz reg ri) = hcat [
2164 pprInstr (BCC cond (BlockId id)) = hcat [
2171 where lbl = mkAsmTempLabel id
2173 pprInstr (BCCFAR cond (BlockId id)) = vcat [
2176 pprCond (condNegate cond),
2180 ptext SLIT("\tb\t"),
2184 where lbl = mkAsmTempLabel id
2186 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2193 pprInstr (MTCTR reg) = hcat [
2195 ptext SLIT("mtctr"),
2199 pprInstr (BCTR _) = hcat [
2203 pprInstr (BL lbl _) = hcat [
2204 ptext SLIT("\tbl\t"),
2207 pprInstr (BCTRL _) = hcat [
2211 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2212 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2214 ptext SLIT("addis"),
2223 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2224 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2225 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2226 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2227 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2228 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2229 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2231 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2232 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2233 pprReg reg2, ptext SLIT(", "),
2235 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2236 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2237 pprReg reg1, ptext SLIT(", "),
2238 ptext SLIT("2, 31, 31") ]
2241 -- for some reason, "andi" doesn't exist.
2242 -- we'll use "andi." instead.
2243 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2245 ptext SLIT("andi."),
2253 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2255 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2256 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2258 pprInstr (XORIS reg1 reg2 imm) = hcat [
2260 ptext SLIT("xoris"),
2269 pprInstr (EXTS sz reg1 reg2) = hcat [
2279 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2280 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2282 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2283 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2284 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2285 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2286 ptext SLIT("\trlwinm\t"),
2298 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2299 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2300 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2301 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2302 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2304 pprInstr (FCMP reg1 reg2) = hcat [
2306 ptext SLIT("fcmpu\tcr0, "),
2307 -- Note: we're using fcmpu, not fcmpo
2308 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2309 -- We don't handle invalid fp ops, so we don't care
2315 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2316 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2318 pprInstr (CRNOR dst src1 src2) = hcat [
2319 ptext SLIT("\tcrnor\t"),
2327 pprInstr (MFCR reg) = hcat [
2334 pprInstr (MFLR reg) = hcat [
2341 pprInstr (FETCHPC reg) = vcat [
2342 ptext SLIT("\tbcl\t20,31,1f"),
2343 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2346 pprInstr LWSYNC = ptext SLIT("\tlwsync")
2348 pprInstr _ = panic "pprInstr (ppc)"
2350 pprLogic op reg1 reg2 ri = hcat [
2355 RIImm _ -> char 'i',
2364 pprUnary op reg1 reg2 = hcat [
2373 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2386 pprRI (RIReg r) = pprReg r
2387 pprRI (RIImm r) = pprImm r
2389 pprFSize F64 = empty
2390 pprFSize F32 = char 's'
2392 -- limit immediate argument for shift instruction to range 0..32
2393 -- (yes, the maximum is really 32, not 31)
2394 limitShiftRI :: RI -> RI
2395 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2398 #endif /* powerpc_TARGET_ARCH */
2401 -- -----------------------------------------------------------------------------
2402 -- Converting floating-point literals to integrals for printing
2404 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2405 castFloatToWord8Array = castSTUArray
2407 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2408 castDoubleToWord8Array = castSTUArray
2410 -- floatToBytes and doubleToBytes convert to the host's byte
2411 -- order. Providing that we're not cross-compiling for a
2412 -- target with the opposite endianness, this should work ok
2415 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2416 -- could they be merged?
2418 floatToBytes :: Float -> [Int]
2421 arr <- newArray_ ((0::Int),3)
2423 arr <- castFloatToWord8Array arr
2424 i0 <- readArray arr 0
2425 i1 <- readArray arr 1
2426 i2 <- readArray arr 2
2427 i3 <- readArray arr 3
2428 return (map fromIntegral [i0,i1,i2,i3])
2431 doubleToBytes :: Double -> [Int]
2434 arr <- newArray_ ((0::Int),7)
2436 arr <- castDoubleToWord8Array arr
2437 i0 <- readArray arr 0
2438 i1 <- readArray arr 1
2439 i2 <- readArray arr 2
2440 i3 <- readArray arr 3
2441 i4 <- readArray arr 4
2442 i5 <- readArray arr 5
2443 i6 <- readArray arr 6
2444 i7 <- readArray arr 7
2445 return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])