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
698 | not (externallyVisibleCLabel lbl) = empty
699 | otherwise = ptext SLIT(".type ") <>
700 pprCLabel_asm lbl <> ptext SLIT(", @object")
705 pprLabel :: CLabel -> Doc
706 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
710 = vcat (map do1 str) $$ do1 0
713 do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
716 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
717 IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
718 IF_ARCH_x86_64(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
719 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
720 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
724 log2 :: Int -> Int -- cache the common ones
729 log2 n = 1 + log2 (n `quot` 2)
732 pprDataItem :: CmmLit -> Doc
734 = vcat (ppr_item (cmmLitRep lit) lit)
738 -- These seem to be common:
739 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
740 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
741 ppr_item F32 (CmmFloat r _)
742 = let bs = floatToBytes (fromRational r)
743 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
744 ppr_item F64 (CmmFloat r _)
745 = let bs = doubleToBytes (fromRational r)
746 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
748 #if sparc_TARGET_ARCH
749 -- copy n paste of x86 version
750 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
751 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
753 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
754 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
756 #if i386_TARGET_ARCH && darwin_TARGET_OS
757 ppr_item I64 (CmmInt x _) =
758 [ptext SLIT("\t.long\t")
759 <> int (fromIntegral (fromIntegral x :: Word32)),
760 ptext SLIT("\t.long\t")
762 (fromIntegral (x `shiftR` 32) :: Word32))]
764 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
765 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
767 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
768 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
769 -- type, which means we can't do pc-relative 64-bit addresses.
770 -- Fortunately we're assuming the small memory model, in which
771 -- all such offsets will fit into 32 bits, so we have to stick
772 -- to 32-bit offset fields and modify the RTS appropriately
774 -- See Note [x86-64-relative] in includes/InfoTables.h
777 | isRelativeReloc x =
778 [ptext SLIT("\t.long\t") <> pprImm imm,
779 ptext SLIT("\t.long\t0")]
781 [ptext SLIT("\t.quad\t") <> pprImm imm]
783 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
784 isRelativeReloc _ = False
786 #if powerpc_TARGET_ARCH
787 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
788 ppr_item I64 (CmmInt x _) =
789 [ptext SLIT("\t.long\t")
791 (fromIntegral (x `shiftR` 32) :: Word32)),
792 ptext SLIT("\t.long\t")
793 <> int (fromIntegral (fromIntegral x :: Word32))]
796 -- fall through to rest of (machine-specific) pprInstr...
798 -- -----------------------------------------------------------------------------
799 -- pprInstr: print an 'Instr'
801 pprInstr :: Instr -> Doc
803 --pprInstr (COMMENT s) = empty -- nuke 'em
805 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
806 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
807 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
808 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
809 ,IF_ARCH_powerpc( IF_OS_linux(
810 ((<>) (ptext SLIT("# ")) (ftext s)),
811 ((<>) (ptext SLIT("; ")) (ftext s)))
815 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
817 pprInstr (NEWBLOCK _)
818 = panic "PprMach.pprInstr: NEWBLOCK"
821 = panic "PprMach.pprInstr: LDATA"
823 -- -----------------------------------------------------------------------------
824 -- pprInstr for an Alpha
826 #if alpha_TARGET_ARCH
828 pprInstr (LD size reg addr)
838 pprInstr (LDA reg addr)
840 ptext SLIT("\tlda\t"),
846 pprInstr (LDAH reg addr)
848 ptext SLIT("\tldah\t"),
854 pprInstr (LDGP reg addr)
856 ptext SLIT("\tldgp\t"),
862 pprInstr (LDI size reg imm)
872 pprInstr (ST size reg addr)
884 ptext SLIT("\tclr\t"),
888 pprInstr (ABS size ri reg)
898 pprInstr (NEG size ov ri reg)
902 if ov then ptext SLIT("v\t") else char '\t',
908 pprInstr (ADD size ov reg1 ri reg2)
912 if ov then ptext SLIT("v\t") else char '\t',
920 pprInstr (SADD size scale reg1 ri reg2)
922 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
933 pprInstr (SUB size ov reg1 ri reg2)
937 if ov then ptext SLIT("v\t") else char '\t',
945 pprInstr (SSUB size scale reg1 ri reg2)
947 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
958 pprInstr (MUL size ov reg1 ri reg2)
962 if ov then ptext SLIT("v\t") else char '\t',
970 pprInstr (DIV size uns reg1 ri reg2)
974 if uns then ptext SLIT("u\t") else char '\t',
982 pprInstr (REM size uns reg1 ri reg2)
986 if uns then ptext SLIT("u\t") else char '\t',
994 pprInstr (NOT ri reg)
1003 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
1004 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
1005 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
1006 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
1007 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
1008 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
1010 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
1011 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
1012 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
1014 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
1015 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
1017 pprInstr (NOP) = ptext SLIT("\tnop")
1019 pprInstr (CMP cond reg1 ri reg2)
1021 ptext SLIT("\tcmp"),
1033 ptext SLIT("\tfclr\t"),
1037 pprInstr (FABS reg1 reg2)
1039 ptext SLIT("\tfabs\t"),
1045 pprInstr (FNEG size reg1 reg2)
1047 ptext SLIT("\tneg"),
1055 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1056 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1057 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1058 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1060 pprInstr (CVTxy size1 size2 reg1 reg2)
1062 ptext SLIT("\tcvt"),
1064 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1071 pprInstr (FCMP size cond reg1 reg2 reg3)
1073 ptext SLIT("\tcmp"),
1084 pprInstr (FMOV reg1 reg2)
1086 ptext SLIT("\tfmov\t"),
1092 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1094 pprInstr (BI NEVER reg lab) = empty
1096 pprInstr (BI cond reg lab)
1106 pprInstr (BF cond reg lab)
1117 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1119 pprInstr (JMP reg addr hint)
1121 ptext SLIT("\tjmp\t"),
1129 pprInstr (BSR imm n)
1130 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1132 pprInstr (JSR reg addr n)
1134 ptext SLIT("\tjsr\t"),
1140 pprInstr (FUNBEGIN clab)
1142 if (externallyVisibleCLabel clab) then
1143 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1146 ptext SLIT("\t.ent "),
1155 pp_lab = pprCLabel_asm clab
1157 -- NEVER use commas within those string literals, cpp will ruin your day
1158 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1159 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1160 ptext SLIT("4240"), char ',',
1161 ptext SLIT("$26"), char ',',
1162 ptext SLIT("0\n\t.prologue 1") ]
1164 pprInstr (FUNEND clab)
1165 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1168 Continue with Alpha-only printing bits and bobs:
1172 pprRI (RIReg r) = pprReg r
1173 pprRI (RIImm r) = pprImm r
1175 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1176 pprRegRIReg name reg1 ri reg2
1188 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1189 pprSizeRegRegReg name size reg1 reg2 reg3
1202 #endif /* alpha_TARGET_ARCH */
1205 -- -----------------------------------------------------------------------------
1206 -- pprInstr for an x86
1208 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1210 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1213 #if 0 /* #ifdef DEBUG */
1214 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1219 pprInstr (MOV size src dst)
1220 = pprSizeOpOp SLIT("mov") size src dst
1222 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1223 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1224 -- movl. But we represent it as a MOVZxL instruction, because
1225 -- the reg alloc would tend to throw away a plain reg-to-reg
1226 -- move, and we still want it to do that.
1228 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1229 -- zero-extension only needs to extend to 32 bits: on x86_64,
1230 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1231 -- instruction is shorter.
1233 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1235 -- here we do some patching, since the physical registers are only set late
1236 -- in the code generation.
1237 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1239 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1240 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1242 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1243 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1245 = pprInstr (ADD size (OpImm displ) dst)
1246 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1248 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1249 = pprSizeOp SLIT("dec") size dst
1250 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1251 = pprSizeOp SLIT("inc") size dst
1252 pprInstr (ADD size src dst)
1253 = pprSizeOpOp SLIT("add") size src dst
1254 pprInstr (ADC size src dst)
1255 = pprSizeOpOp SLIT("adc") size src dst
1256 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1257 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1259 {- A hack. The Intel documentation says that "The two and three
1260 operand forms [of IMUL] may also be used with unsigned operands
1261 because the lower half of the product is the same regardless if
1262 (sic) the operands are signed or unsigned. The CF and OF flags,
1263 however, cannot be used to determine if the upper half of the
1264 result is non-zero." So there.
1266 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1267 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1269 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1270 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1271 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1273 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1274 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1276 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1277 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1278 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1280 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1282 pprInstr (CMP size src dst)
1283 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1284 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1286 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1287 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1288 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1290 -- both unused (SDM):
1291 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1292 -- pprInstr POPA = ptext SLIT("\tpopal")
1294 pprInstr NOP = ptext SLIT("\tnop")
1295 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1296 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1298 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1300 pprInstr (JXX cond (BlockId id))
1301 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1302 where lab = mkAsmTempLabel id
1304 pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
1306 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1307 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1308 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1309 pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1310 pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1312 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1313 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1314 pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
1316 #if x86_64_TARGET_ARCH
1317 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1319 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1321 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1322 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1323 pprInstr (CVTTSS2SIQ from to) = pprOpReg SLIT("cvttss2siq") from to
1324 pprInstr (CVTTSD2SIQ from to) = pprOpReg SLIT("cvttsd2siq") from to
1325 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ssq") from to
1326 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sdq") from to
1329 -- FETCHGOT for PIC on ELF platforms
1330 pprInstr (FETCHGOT reg)
1331 = vcat [ ptext SLIT("\tcall 1f"),
1332 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1333 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1337 -- FETCHPC for PIC on Darwin/x86
1338 -- get the instruction pointer into a register
1339 -- (Terminology note: the IP is called Program Counter on PPC,
1340 -- and it's a good thing to use the same name on both platforms)
1341 pprInstr (FETCHPC reg)
1342 = vcat [ ptext SLIT("\tcall 1f"),
1343 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1350 -- -----------------------------------------------------------------------------
1351 -- i386 floating-point
1353 #if i386_TARGET_ARCH
1354 -- Simulating a flat register set on the x86 FP stack is tricky.
1355 -- you have to free %st(7) before pushing anything on the FP reg stack
1356 -- so as to preclude the possibility of a FP stack overflow exception.
1357 pprInstr g@(GMOV src dst)
1361 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1363 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1364 pprInstr g@(GLD sz addr dst)
1365 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1366 pprAddr addr, gsemi, gpop dst 1])
1368 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1369 pprInstr g@(GST sz src addr)
1370 = pprG g (hcat [gtab, gpush src 0, gsemi,
1371 text "fstp", pprSize sz, gsp, pprAddr addr])
1373 pprInstr g@(GLDZ dst)
1374 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1375 pprInstr g@(GLD1 dst)
1376 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1378 pprInstr g@(GFTOI src dst)
1379 = pprInstr (GDTOI src dst)
1380 pprInstr g@(GDTOI src dst)
1381 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1382 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1385 pprInstr g@(GITOF src dst)
1386 = pprInstr (GITOD src dst)
1387 pprInstr g@(GITOD src dst)
1388 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1389 text " ; ffree %st(7); fildl (%esp) ; ",
1390 gpop dst 1, text " ; addl $4,%esp"])
1392 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1393 this far into the jungle AND you give a Rat's Ass (tm) what's going
1394 on, here's the deal. Generate code to do a floating point comparison
1395 of src1 and src2, of kind cond, and set the Zero flag if true.
1397 The complications are to do with handling NaNs correctly. We want the
1398 property that if either argument is NaN, then the result of the
1399 comparison is False ... except if we're comparing for inequality,
1400 in which case the answer is True.
1402 Here's how the general (non-inequality) case works. As an
1403 example, consider generating the an equality test:
1405 pushl %eax -- we need to mess with this
1406 <get src1 to top of FPU stack>
1407 fcomp <src2 location in FPU stack> and pop pushed src1
1408 -- Result of comparison is in FPU Status Register bits
1410 fstsw %ax -- Move FPU Status Reg to %ax
1411 sahf -- move C3 C2 C0 from %ax to integer flag reg
1412 -- now the serious magic begins
1413 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1414 sete %al -- %al = if arg1 == arg2 then 1 else 0
1415 andb %ah,%al -- %al &= %ah
1416 -- so %al == 1 iff (comparable && same); else it holds 0
1417 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1418 else %al == 0xFF, ZeroFlag=0
1419 -- the zero flag is now set as we desire.
1422 The special case of inequality differs thusly:
1424 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1425 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1426 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1427 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1428 else (%al == 0xFF, ZF=0)
1430 pprInstr g@(GCMP cond src1 src2)
1431 | case cond of { NE -> True; other -> False }
1433 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1434 hcat [gtab, text "fcomp ", greg src2 1,
1435 text "; fstsw %ax ; sahf ; setpe %ah"],
1436 hcat [gtab, text "setne %al ; ",
1437 text "orb %ah,%al ; decb %al ; popl %eax"]
1441 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1442 hcat [gtab, text "fcomp ", greg src2 1,
1443 text "; fstsw %ax ; sahf ; setpo %ah"],
1444 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1445 text "andb %ah,%al ; decb %al ; popl %eax"]
1448 {- On the 486, the flags set by FP compare are the unsigned ones!
1449 (This looks like a HACK to me. WDP 96/03)
1451 fix_FP_cond :: Cond -> Cond
1452 fix_FP_cond GE = GEU
1453 fix_FP_cond GTT = GU
1454 fix_FP_cond LTT = LU
1455 fix_FP_cond LE = LEU
1456 fix_FP_cond EQQ = EQQ
1458 -- there should be no others
1461 pprInstr g@(GABS sz src dst)
1462 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1463 pprInstr g@(GNEG sz src dst)
1464 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1466 pprInstr g@(GSQRT sz src dst)
1467 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1468 hcat [gtab, gcoerceto sz, gpop dst 1])
1469 pprInstr g@(GSIN sz src dst)
1470 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1471 hcat [gtab, gcoerceto sz, gpop dst 1])
1472 pprInstr g@(GCOS sz src dst)
1473 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1474 hcat [gtab, gcoerceto sz, gpop dst 1])
1475 pprInstr g@(GTAN sz src dst)
1476 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1477 gpush src 0, text " ; fptan ; ",
1478 text " fstp %st(0)"] $$
1479 hcat [gtab, gcoerceto sz, gpop dst 1])
1481 -- In the translations for GADD, GMUL, GSUB and GDIV,
1482 -- the first two cases are mere optimisations. The otherwise clause
1483 -- generates correct code under all circumstances.
1485 pprInstr g@(GADD sz src1 src2 dst)
1487 = pprG g (text "\t#GADD-xxxcase1" $$
1488 hcat [gtab, gpush src2 0,
1489 text " ; faddp %st(0),", greg src1 1])
1491 = pprG g (text "\t#GADD-xxxcase2" $$
1492 hcat [gtab, gpush src1 0,
1493 text " ; faddp %st(0),", greg src2 1])
1495 = pprG g (hcat [gtab, gpush src1 0,
1496 text " ; fadd ", greg src2 1, text ",%st(0)",
1500 pprInstr g@(GMUL sz src1 src2 dst)
1502 = pprG g (text "\t#GMUL-xxxcase1" $$
1503 hcat [gtab, gpush src2 0,
1504 text " ; fmulp %st(0),", greg src1 1])
1506 = pprG g (text "\t#GMUL-xxxcase2" $$
1507 hcat [gtab, gpush src1 0,
1508 text " ; fmulp %st(0),", greg src2 1])
1510 = pprG g (hcat [gtab, gpush src1 0,
1511 text " ; fmul ", greg src2 1, text ",%st(0)",
1515 pprInstr g@(GSUB sz src1 src2 dst)
1517 = pprG g (text "\t#GSUB-xxxcase1" $$
1518 hcat [gtab, gpush src2 0,
1519 text " ; fsubrp %st(0),", greg src1 1])
1521 = pprG g (text "\t#GSUB-xxxcase2" $$
1522 hcat [gtab, gpush src1 0,
1523 text " ; fsubp %st(0),", greg src2 1])
1525 = pprG g (hcat [gtab, gpush src1 0,
1526 text " ; fsub ", greg src2 1, text ",%st(0)",
1530 pprInstr g@(GDIV sz src1 src2 dst)
1532 = pprG g (text "\t#GDIV-xxxcase1" $$
1533 hcat [gtab, gpush src2 0,
1534 text " ; fdivrp %st(0),", greg src1 1])
1536 = pprG g (text "\t#GDIV-xxxcase2" $$
1537 hcat [gtab, gpush src1 0,
1538 text " ; fdivp %st(0),", greg src2 1])
1540 = pprG g (hcat [gtab, gpush src1 0,
1541 text " ; fdiv ", greg src2 1, text ",%st(0)",
1546 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1547 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1550 --------------------------
1552 -- coerce %st(0) to the specified size
1553 gcoerceto F64 = empty
1554 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1557 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1559 = hcat [text "fstp ", greg reg offset]
1561 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1566 gregno (RealReg i) = i
1567 gregno other = --pprPanic "gregno" (ppr other)
1568 999 -- bogus; only needed for debug printing
1570 pprG :: Instr -> Doc -> Doc
1572 = (char '#' <> pprGInstr fake) $$ actual
1574 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1575 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1576 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1578 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1579 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1581 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1582 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1584 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1585 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1587 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1588 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1589 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1590 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1591 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1592 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1593 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1595 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1596 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1597 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1598 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1601 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1603 -- Continue with I386-only printing bits and bobs:
1605 pprDollImm :: Imm -> Doc
1607 pprDollImm i = ptext SLIT("$") <> pprImm i
1609 pprOperand :: MachRep -> Operand -> Doc
1610 pprOperand s (OpReg r) = pprReg s r
1611 pprOperand s (OpImm i) = pprDollImm i
1612 pprOperand s (OpAddr ea) = pprAddr ea
1614 pprMnemonic_ :: LitString -> Doc
1616 char '\t' <> ptext name <> space
1618 pprMnemonic :: LitString -> MachRep -> Doc
1619 pprMnemonic name size =
1620 char '\t' <> ptext name <> pprSize size <> space
1622 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1623 pprSizeImmOp name size imm op1
1625 pprMnemonic name size,
1632 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1633 pprSizeOp name size op1
1635 pprMnemonic name size,
1639 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1640 pprSizeOpOp name size op1 op2
1642 pprMnemonic name size,
1643 pprOperand size op1,
1648 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1649 pprOpOp name size op1 op2
1652 pprOperand size op1,
1657 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1658 pprSizeReg name size reg1
1660 pprMnemonic name size,
1664 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1665 pprSizeRegReg name size reg1 reg2
1667 pprMnemonic name size,
1673 pprRegReg :: LitString -> Reg -> Reg -> Doc
1674 pprRegReg name reg1 reg2
1677 pprReg wordRep reg1,
1682 pprOpReg :: LitString -> Operand -> Reg -> Doc
1683 pprOpReg name op1 reg2
1686 pprOperand wordRep op1,
1691 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1692 pprCondRegReg name size cond reg1 reg2
1703 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1704 pprSizeSizeRegReg name size1 size2 reg1 reg2
1717 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1718 pprSizeRegRegReg name size reg1 reg2 reg3
1720 pprMnemonic name size,
1728 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1729 pprSizeAddrReg name size op dst
1731 pprMnemonic name size,
1737 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1738 pprSizeRegAddr name size src op
1740 pprMnemonic name size,
1746 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1747 pprShift name size src dest
1749 pprMnemonic name size,
1750 pprOperand I8 src, -- src is 8-bit sized
1752 pprOperand size dest
1755 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1756 pprSizeOpOpCoerce name size1 size2 op1 op2
1757 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1758 pprOperand size1 op1,
1760 pprOperand size2 op2
1763 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1764 pprCondInstr name cond arg
1765 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1767 #endif /* i386_TARGET_ARCH */
1770 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1772 #if sparc_TARGET_ARCH
1774 -- a clumsy hack for now, to handle possible double alignment problems
1776 -- even clumsier, to allow for RegReg regs that show when doing indexed
1777 -- reads (bytearrays).
1780 -- Translate to the following:
1783 -- ld [g1+4],%f(n+1)
1784 -- sub g1,g2,g1 -- to restore g1
1786 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1788 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1789 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1790 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1791 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1796 -- ld [addr+4],%f(n+1)
1797 pprInstr (LD F64 addr reg) | isJust off_addr
1799 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1800 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1803 off_addr = addrOffset addr 4
1804 addr2 = case off_addr of Just x -> x
1807 pprInstr (LD size addr reg)
1818 -- The same clumsy hack as above
1820 -- Translate to the following:
1823 -- st %f(n+1),[g1+4]
1824 -- sub g1,g2,g1 -- to restore g1
1825 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1827 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1828 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1830 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1831 pprReg g1, ptext SLIT("+4]")],
1832 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1837 -- st %f(n+1),[addr+4]
1838 pprInstr (ST F64 reg addr) | isJust off_addr
1840 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1841 pprAddr addr, rbrack],
1842 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1843 pprAddr addr2, rbrack]
1846 off_addr = addrOffset addr 4
1847 addr2 = case off_addr of Just x -> x
1849 -- no distinction is made between signed and unsigned bytes on stores for the
1850 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1851 -- so we call a special-purpose pprSize for ST..
1853 pprInstr (ST size reg addr)
1864 pprInstr (ADD x cc reg1 ri reg2)
1865 | not x && not cc && riZero ri
1866 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1868 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1870 pprInstr (SUB x cc reg1 ri reg2)
1871 | not x && cc && reg2 == g0
1872 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1873 | not x && not cc && riZero ri
1874 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1876 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1878 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1879 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1881 pprInstr (OR b reg1 ri reg2)
1882 | not b && reg1 == g0
1883 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1885 RIReg rrr | rrr == reg2 -> empty
1888 = pprRegRIReg SLIT("or") b reg1 ri reg2
1890 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1892 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1893 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1895 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1896 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1897 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1899 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1900 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1901 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1903 pprInstr (SETHI imm reg)
1905 ptext SLIT("\tsethi\t"),
1911 pprInstr NOP = ptext SLIT("\tnop")
1913 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1914 pprInstr (FABS F64 reg1 reg2)
1915 = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1916 (if (reg1 == reg2) then empty
1917 else (<>) (char '\n')
1918 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1920 pprInstr (FADD size reg1 reg2 reg3)
1921 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1922 pprInstr (FCMP e size reg1 reg2)
1923 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1924 pprInstr (FDIV size reg1 reg2 reg3)
1925 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1927 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1928 pprInstr (FMOV F64 reg1 reg2)
1929 = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1930 (if (reg1 == reg2) then empty
1931 else (<>) (char '\n')
1932 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1934 pprInstr (FMUL size reg1 reg2 reg3)
1935 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1937 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1938 pprInstr (FNEG F64 reg1 reg2)
1939 = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1940 (if (reg1 == reg2) then empty
1941 else (<>) (char '\n')
1942 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1944 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1945 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1946 pprInstr (FxTOy size1 size2 reg1 reg2)
1953 F64 -> SLIT("dto")),
1958 F64 -> SLIT("d\t")),
1959 pprReg reg1, comma, pprReg reg2
1963 pprInstr (BI cond b lab)
1965 ptext SLIT("\tb"), pprCond cond,
1966 if b then pp_comma_a else empty,
1971 pprInstr (BF cond b lab)
1973 ptext SLIT("\tfb"), pprCond cond,
1974 if b then pp_comma_a else empty,
1979 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1981 pprInstr (CALL (Left imm) n _)
1982 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1983 pprInstr (CALL (Right reg) n _)
1984 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1987 pprRI (RIReg r) = pprReg r
1988 pprRI (RIImm r) = pprImm r
1990 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1991 pprSizeRegReg name size reg1 reg2
1996 F32 -> ptext SLIT("s\t")
1997 F64 -> ptext SLIT("d\t")),
2003 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
2004 pprSizeRegRegReg name size reg1 reg2 reg3
2009 F32 -> ptext SLIT("s\t")
2010 F64 -> ptext SLIT("d\t")),
2018 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2019 pprRegRIReg name b reg1 ri reg2
2023 if b then ptext SLIT("cc\t") else char '\t',
2031 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2032 pprRIReg name b ri reg1
2036 if b then ptext SLIT("cc\t") else char '\t',
2042 pp_ld_lbracket = ptext SLIT("\tld\t[")
2043 pp_rbracket_comma = text "],"
2044 pp_comma_lbracket = text ",["
2045 pp_comma_a = text ",a"
2047 #endif /* sparc_TARGET_ARCH */
2050 -- -----------------------------------------------------------------------------
2051 -- pprInstr for PowerPC
2053 #if powerpc_TARGET_ARCH
2054 pprInstr (LD sz reg addr) = hcat [
2063 case addr of AddrRegImm _ _ -> empty
2064 AddrRegReg _ _ -> char 'x',
2070 pprInstr (LA sz reg addr) = hcat [
2079 case addr of AddrRegImm _ _ -> empty
2080 AddrRegReg _ _ -> char 'x',
2086 pprInstr (ST sz reg addr) = hcat [
2090 case addr of AddrRegImm _ _ -> empty
2091 AddrRegReg _ _ -> char 'x',
2097 pprInstr (STU sz reg addr) = hcat [
2102 case addr of AddrRegImm _ _ -> empty
2103 AddrRegReg _ _ -> char 'x',
2108 pprInstr (LIS reg imm) = hcat [
2116 pprInstr (LI reg imm) = hcat [
2124 pprInstr (MR reg1 reg2)
2125 | reg1 == reg2 = empty
2126 | otherwise = hcat [
2128 case regClass reg1 of
2129 RcInteger -> ptext SLIT("mr")
2130 _ -> ptext SLIT("fmr"),
2136 pprInstr (CMP sz reg ri) = hcat [
2152 pprInstr (CMPL sz reg ri) = hcat [
2168 pprInstr (BCC cond (BlockId id)) = hcat [
2175 where lbl = mkAsmTempLabel id
2177 pprInstr (BCCFAR cond (BlockId id)) = vcat [
2180 pprCond (condNegate cond),
2184 ptext SLIT("\tb\t"),
2188 where lbl = mkAsmTempLabel id
2190 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2197 pprInstr (MTCTR reg) = hcat [
2199 ptext SLIT("mtctr"),
2203 pprInstr (BCTR _) = hcat [
2207 pprInstr (BL lbl _) = hcat [
2208 ptext SLIT("\tbl\t"),
2211 pprInstr (BCTRL _) = hcat [
2215 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2216 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2218 ptext SLIT("addis"),
2227 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2228 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2229 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2230 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2231 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2232 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2233 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2235 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2236 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2237 pprReg reg2, ptext SLIT(", "),
2239 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2240 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2241 pprReg reg1, ptext SLIT(", "),
2242 ptext SLIT("2, 31, 31") ]
2245 -- for some reason, "andi" doesn't exist.
2246 -- we'll use "andi." instead.
2247 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2249 ptext SLIT("andi."),
2257 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2259 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2260 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2262 pprInstr (XORIS reg1 reg2 imm) = hcat [
2264 ptext SLIT("xoris"),
2273 pprInstr (EXTS sz reg1 reg2) = hcat [
2283 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2284 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2286 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2287 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2288 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2289 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2290 ptext SLIT("\trlwinm\t"),
2302 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2303 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2304 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2305 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2306 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2308 pprInstr (FCMP reg1 reg2) = hcat [
2310 ptext SLIT("fcmpu\tcr0, "),
2311 -- Note: we're using fcmpu, not fcmpo
2312 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2313 -- We don't handle invalid fp ops, so we don't care
2319 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2320 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2322 pprInstr (CRNOR dst src1 src2) = hcat [
2323 ptext SLIT("\tcrnor\t"),
2331 pprInstr (MFCR reg) = hcat [
2338 pprInstr (MFLR reg) = hcat [
2345 pprInstr (FETCHPC reg) = vcat [
2346 ptext SLIT("\tbcl\t20,31,1f"),
2347 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2350 pprInstr LWSYNC = ptext SLIT("\tlwsync")
2352 pprInstr _ = panic "pprInstr (ppc)"
2354 pprLogic op reg1 reg2 ri = hcat [
2359 RIImm _ -> char 'i',
2368 pprUnary op reg1 reg2 = hcat [
2377 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2390 pprRI (RIReg r) = pprReg r
2391 pprRI (RIImm r) = pprImm r
2393 pprFSize F64 = empty
2394 pprFSize F32 = char 's'
2396 -- limit immediate argument for shift instruction to range 0..32
2397 -- (yes, the maximum is really 32, not 31)
2398 limitShiftRI :: RI -> RI
2399 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2402 #endif /* powerpc_TARGET_ARCH */
2405 -- -----------------------------------------------------------------------------
2406 -- Converting floating-point literals to integrals for printing
2408 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2409 castFloatToWord8Array = castSTUArray
2411 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2412 castDoubleToWord8Array = castSTUArray
2414 -- floatToBytes and doubleToBytes convert to the host's byte
2415 -- order. Providing that we're not cross-compiling for a
2416 -- target with the opposite endianness, this should work ok
2419 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2420 -- could they be merged?
2422 floatToBytes :: Float -> [Int]
2425 arr <- newArray_ ((0::Int),3)
2427 arr <- castFloatToWord8Array arr
2428 i0 <- readArray arr 0
2429 i1 <- readArray arr 1
2430 i2 <- readArray arr 2
2431 i3 <- readArray arr 3
2432 return (map fromIntegral [i0,i1,i2,i3])
2435 doubleToBytes :: Double -> [Int]
2438 arr <- newArray_ ((0::Int),7)
2440 arr <- castDoubleToWord8Array arr
2441 i0 <- readArray arr 0
2442 i1 <- readArray arr 1
2443 i2 <- readArray arr 2
2444 i3 <- readArray arr 3
2445 i4 <- readArray arr 4
2446 i5 <- readArray arr 5
2447 i6 <- readArray arr 6
2448 i7 <- readArray arr 7
2449 return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])