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 .rodata\n\t.align 4"))
650 ,IF_ARCH_x86_64(IF_OS_darwin(SLIT(".const_data\n.align 3"),
651 SLIT(".section .rodata\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 pprLabel :: CLabel -> Doc
696 pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
700 = vcat (map do1 str) $$ do1 0
703 do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
706 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
707 IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
708 IF_ARCH_x86_64(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
709 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
710 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
714 log2 :: Int -> Int -- cache the common ones
719 log2 n = 1 + log2 (n `quot` 2)
722 pprDataItem :: CmmLit -> Doc
724 = vcat (ppr_item (cmmLitRep lit) lit)
728 -- These seem to be common:
729 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
730 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
731 ppr_item F32 (CmmFloat r _)
732 = let bs = floatToBytes (fromRational r)
733 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
734 ppr_item F64 (CmmFloat r _)
735 = let bs = doubleToBytes (fromRational r)
736 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
738 #if sparc_TARGET_ARCH
739 -- copy n paste of x86 version
740 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
741 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
743 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
744 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
746 #if i386_TARGET_ARCH && darwin_TARGET_OS
747 ppr_item I64 (CmmInt x _) =
748 [ptext SLIT("\t.long\t")
749 <> int (fromIntegral (fromIntegral x :: Word32)),
750 ptext SLIT("\t.long\t")
752 (fromIntegral (x `shiftR` 32) :: Word32))]
754 #if i386_TARGET_ARCH || (darwin_TARGET_OS && x86_64_TARGET_ARCH)
755 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
757 #if x86_64_TARGET_ARCH && !darwin_TARGET_OS
758 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
759 -- type, which means we can't do pc-relative 64-bit addresses.
760 -- Fortunately we're assuming the small memory model, in which
761 -- all such offsets will fit into 32 bits, so we have to stick
762 -- to 32-bit offset fields and modify the RTS appropriately
764 -- See Note [x86-64-relative] in includes/InfoTables.h
767 | isRelativeReloc x =
768 [ptext SLIT("\t.long\t") <> pprImm imm,
769 ptext SLIT("\t.long\t0")]
771 [ptext SLIT("\t.quad\t") <> pprImm imm]
773 isRelativeReloc (CmmLabelOff _ _) = True
774 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
775 isRelativeReloc _ = False
777 #if powerpc_TARGET_ARCH
778 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
779 ppr_item I64 (CmmInt x _) =
780 [ptext SLIT("\t.long\t")
782 (fromIntegral (x `shiftR` 32) :: Word32)),
783 ptext SLIT("\t.long\t")
784 <> int (fromIntegral (fromIntegral x :: Word32))]
787 -- fall through to rest of (machine-specific) pprInstr...
789 -- -----------------------------------------------------------------------------
790 -- pprInstr: print an 'Instr'
792 pprInstr :: Instr -> Doc
794 --pprInstr (COMMENT s) = empty -- nuke 'em
796 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
797 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
798 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
799 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
800 ,IF_ARCH_powerpc( IF_OS_linux(
801 ((<>) (ptext SLIT("# ")) (ftext s)),
802 ((<>) (ptext SLIT("; ")) (ftext s)))
806 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
808 pprInstr (NEWBLOCK _)
809 = panic "PprMach.pprInstr: NEWBLOCK"
812 = panic "PprMach.pprInstr: LDATA"
814 -- -----------------------------------------------------------------------------
815 -- pprInstr for an Alpha
817 #if alpha_TARGET_ARCH
819 pprInstr (LD size reg addr)
829 pprInstr (LDA reg addr)
831 ptext SLIT("\tlda\t"),
837 pprInstr (LDAH reg addr)
839 ptext SLIT("\tldah\t"),
845 pprInstr (LDGP reg addr)
847 ptext SLIT("\tldgp\t"),
853 pprInstr (LDI size reg imm)
863 pprInstr (ST size reg addr)
875 ptext SLIT("\tclr\t"),
879 pprInstr (ABS size ri reg)
889 pprInstr (NEG size ov ri reg)
893 if ov then ptext SLIT("v\t") else char '\t',
899 pprInstr (ADD size ov reg1 ri reg2)
903 if ov then ptext SLIT("v\t") else char '\t',
911 pprInstr (SADD size scale reg1 ri reg2)
913 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
924 pprInstr (SUB size ov reg1 ri reg2)
928 if ov then ptext SLIT("v\t") else char '\t',
936 pprInstr (SSUB size scale reg1 ri reg2)
938 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
949 pprInstr (MUL size ov reg1 ri reg2)
953 if ov then ptext SLIT("v\t") else char '\t',
961 pprInstr (DIV size uns reg1 ri reg2)
965 if uns then ptext SLIT("u\t") else char '\t',
973 pprInstr (REM size uns reg1 ri reg2)
977 if uns then ptext SLIT("u\t") else char '\t',
985 pprInstr (NOT ri reg)
994 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
995 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
996 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
997 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
998 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
999 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
1001 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
1002 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
1003 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
1005 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
1006 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
1008 pprInstr (NOP) = ptext SLIT("\tnop")
1010 pprInstr (CMP cond reg1 ri reg2)
1012 ptext SLIT("\tcmp"),
1024 ptext SLIT("\tfclr\t"),
1028 pprInstr (FABS reg1 reg2)
1030 ptext SLIT("\tfabs\t"),
1036 pprInstr (FNEG size reg1 reg2)
1038 ptext SLIT("\tneg"),
1046 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1047 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1048 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1049 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1051 pprInstr (CVTxy size1 size2 reg1 reg2)
1053 ptext SLIT("\tcvt"),
1055 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1062 pprInstr (FCMP size cond reg1 reg2 reg3)
1064 ptext SLIT("\tcmp"),
1075 pprInstr (FMOV reg1 reg2)
1077 ptext SLIT("\tfmov\t"),
1083 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1085 pprInstr (BI NEVER reg lab) = empty
1087 pprInstr (BI cond reg lab)
1097 pprInstr (BF cond reg lab)
1108 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1110 pprInstr (JMP reg addr hint)
1112 ptext SLIT("\tjmp\t"),
1120 pprInstr (BSR imm n)
1121 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1123 pprInstr (JSR reg addr n)
1125 ptext SLIT("\tjsr\t"),
1131 pprInstr (FUNBEGIN clab)
1133 if (externallyVisibleCLabel clab) then
1134 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1137 ptext SLIT("\t.ent "),
1146 pp_lab = pprCLabel_asm clab
1148 -- NEVER use commas within those string literals, cpp will ruin your day
1149 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1150 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1151 ptext SLIT("4240"), char ',',
1152 ptext SLIT("$26"), char ',',
1153 ptext SLIT("0\n\t.prologue 1") ]
1155 pprInstr (FUNEND clab)
1156 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1159 Continue with Alpha-only printing bits and bobs:
1163 pprRI (RIReg r) = pprReg r
1164 pprRI (RIImm r) = pprImm r
1166 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1167 pprRegRIReg name reg1 ri reg2
1179 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1180 pprSizeRegRegReg name size reg1 reg2 reg3
1193 #endif /* alpha_TARGET_ARCH */
1196 -- -----------------------------------------------------------------------------
1197 -- pprInstr for an x86
1199 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1201 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1204 #if 0 /* #ifdef DEBUG */
1205 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1210 pprInstr (MOV size src dst)
1211 = pprSizeOpOp SLIT("mov") size src dst
1213 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1214 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1215 -- movl. But we represent it as a MOVZxL instruction, because
1216 -- the reg alloc would tend to throw away a plain reg-to-reg
1217 -- move, and we still want it to do that.
1219 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1220 -- zero-extension only needs to extend to 32 bits: on x86_64,
1221 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1222 -- instruction is shorter.
1224 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1226 -- here we do some patching, since the physical registers are only set late
1227 -- in the code generation.
1228 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1230 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1231 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1233 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1234 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1236 = pprInstr (ADD size (OpImm displ) dst)
1237 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1239 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1240 = pprSizeOp SLIT("dec") size dst
1241 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1242 = pprSizeOp SLIT("inc") size dst
1243 pprInstr (ADD size src dst)
1244 = pprSizeOpOp SLIT("add") size src dst
1245 pprInstr (ADC size src dst)
1246 = pprSizeOpOp SLIT("adc") size src dst
1247 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1248 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1250 {- A hack. The Intel documentation says that "The two and three
1251 operand forms [of IMUL] may also be used with unsigned operands
1252 because the lower half of the product is the same regardless if
1253 (sic) the operands are signed or unsigned. The CF and OF flags,
1254 however, cannot be used to determine if the upper half of the
1255 result is non-zero." So there.
1257 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1258 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1260 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1261 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1262 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1264 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1265 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1267 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1268 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1269 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1271 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1273 pprInstr (CMP size src dst)
1274 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1275 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1277 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1278 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1279 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1281 -- both unused (SDM):
1282 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1283 -- pprInstr POPA = ptext SLIT("\tpopal")
1285 pprInstr NOP = ptext SLIT("\tnop")
1286 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1287 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1289 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1291 pprInstr (JXX cond (BlockId id))
1292 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1293 where lab = mkAsmTempLabel id
1295 pprInstr (JXX_GBL cond imm) = pprCondInstr SLIT("j") cond (pprImm imm)
1297 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1298 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1299 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1300 pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1301 pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1303 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1304 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1305 pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
1307 #if x86_64_TARGET_ARCH
1308 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1310 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1312 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1313 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1314 pprInstr (CVTTSS2SIQ from to) = pprOpReg SLIT("cvttss2siq") from to
1315 pprInstr (CVTTSD2SIQ from to) = pprOpReg SLIT("cvttsd2siq") from to
1316 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ssq") from to
1317 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sdq") from to
1320 -- FETCHGOT for PIC on ELF platforms
1321 pprInstr (FETCHGOT reg)
1322 = vcat [ ptext SLIT("\tcall 1f"),
1323 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1324 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1328 -- FETCHPC for PIC on Darwin/x86
1329 -- get the instruction pointer into a register
1330 -- (Terminology note: the IP is called Program Counter on PPC,
1331 -- and it's a good thing to use the same name on both platforms)
1332 pprInstr (FETCHPC reg)
1333 = vcat [ ptext SLIT("\tcall 1f"),
1334 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1341 -- -----------------------------------------------------------------------------
1342 -- i386 floating-point
1344 #if i386_TARGET_ARCH
1345 -- Simulating a flat register set on the x86 FP stack is tricky.
1346 -- you have to free %st(7) before pushing anything on the FP reg stack
1347 -- so as to preclude the possibility of a FP stack overflow exception.
1348 pprInstr g@(GMOV src dst)
1352 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1354 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1355 pprInstr g@(GLD sz addr dst)
1356 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1357 pprAddr addr, gsemi, gpop dst 1])
1359 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1360 pprInstr g@(GST sz src addr)
1361 = pprG g (hcat [gtab, gpush src 0, gsemi,
1362 text "fstp", pprSize sz, gsp, pprAddr addr])
1364 pprInstr g@(GLDZ dst)
1365 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1366 pprInstr g@(GLD1 dst)
1367 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1369 pprInstr g@(GFTOI src dst)
1370 = pprInstr (GDTOI src dst)
1371 pprInstr g@(GDTOI src dst)
1372 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1373 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1376 pprInstr g@(GITOF src dst)
1377 = pprInstr (GITOD src dst)
1378 pprInstr g@(GITOD src dst)
1379 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1380 text " ; ffree %st(7); fildl (%esp) ; ",
1381 gpop dst 1, text " ; addl $4,%esp"])
1383 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1384 this far into the jungle AND you give a Rat's Ass (tm) what's going
1385 on, here's the deal. Generate code to do a floating point comparison
1386 of src1 and src2, of kind cond, and set the Zero flag if true.
1388 The complications are to do with handling NaNs correctly. We want the
1389 property that if either argument is NaN, then the result of the
1390 comparison is False ... except if we're comparing for inequality,
1391 in which case the answer is True.
1393 Here's how the general (non-inequality) case works. As an
1394 example, consider generating the an equality test:
1396 pushl %eax -- we need to mess with this
1397 <get src1 to top of FPU stack>
1398 fcomp <src2 location in FPU stack> and pop pushed src1
1399 -- Result of comparison is in FPU Status Register bits
1401 fstsw %ax -- Move FPU Status Reg to %ax
1402 sahf -- move C3 C2 C0 from %ax to integer flag reg
1403 -- now the serious magic begins
1404 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1405 sete %al -- %al = if arg1 == arg2 then 1 else 0
1406 andb %ah,%al -- %al &= %ah
1407 -- so %al == 1 iff (comparable && same); else it holds 0
1408 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1409 else %al == 0xFF, ZeroFlag=0
1410 -- the zero flag is now set as we desire.
1413 The special case of inequality differs thusly:
1415 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1416 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1417 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1418 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1419 else (%al == 0xFF, ZF=0)
1421 pprInstr g@(GCMP cond src1 src2)
1422 | case cond of { NE -> True; other -> False }
1424 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1425 hcat [gtab, text "fcomp ", greg src2 1,
1426 text "; fstsw %ax ; sahf ; setpe %ah"],
1427 hcat [gtab, text "setne %al ; ",
1428 text "orb %ah,%al ; decb %al ; popl %eax"]
1432 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1433 hcat [gtab, text "fcomp ", greg src2 1,
1434 text "; fstsw %ax ; sahf ; setpo %ah"],
1435 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1436 text "andb %ah,%al ; decb %al ; popl %eax"]
1439 {- On the 486, the flags set by FP compare are the unsigned ones!
1440 (This looks like a HACK to me. WDP 96/03)
1442 fix_FP_cond :: Cond -> Cond
1443 fix_FP_cond GE = GEU
1444 fix_FP_cond GTT = GU
1445 fix_FP_cond LTT = LU
1446 fix_FP_cond LE = LEU
1447 fix_FP_cond EQQ = EQQ
1449 -- there should be no others
1452 pprInstr g@(GABS sz src dst)
1453 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1454 pprInstr g@(GNEG sz src dst)
1455 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1457 pprInstr g@(GSQRT sz src dst)
1458 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1459 hcat [gtab, gcoerceto sz, gpop dst 1])
1460 pprInstr g@(GSIN sz src dst)
1461 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1462 hcat [gtab, gcoerceto sz, gpop dst 1])
1463 pprInstr g@(GCOS sz src dst)
1464 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1465 hcat [gtab, gcoerceto sz, gpop dst 1])
1466 pprInstr g@(GTAN sz src dst)
1467 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1468 gpush src 0, text " ; fptan ; ",
1469 text " fstp %st(0)"] $$
1470 hcat [gtab, gcoerceto sz, gpop dst 1])
1472 -- In the translations for GADD, GMUL, GSUB and GDIV,
1473 -- the first two cases are mere optimisations. The otherwise clause
1474 -- generates correct code under all circumstances.
1476 pprInstr g@(GADD sz src1 src2 dst)
1478 = pprG g (text "\t#GADD-xxxcase1" $$
1479 hcat [gtab, gpush src2 0,
1480 text " ; faddp %st(0),", greg src1 1])
1482 = pprG g (text "\t#GADD-xxxcase2" $$
1483 hcat [gtab, gpush src1 0,
1484 text " ; faddp %st(0),", greg src2 1])
1486 = pprG g (hcat [gtab, gpush src1 0,
1487 text " ; fadd ", greg src2 1, text ",%st(0)",
1491 pprInstr g@(GMUL sz src1 src2 dst)
1493 = pprG g (text "\t#GMUL-xxxcase1" $$
1494 hcat [gtab, gpush src2 0,
1495 text " ; fmulp %st(0),", greg src1 1])
1497 = pprG g (text "\t#GMUL-xxxcase2" $$
1498 hcat [gtab, gpush src1 0,
1499 text " ; fmulp %st(0),", greg src2 1])
1501 = pprG g (hcat [gtab, gpush src1 0,
1502 text " ; fmul ", greg src2 1, text ",%st(0)",
1506 pprInstr g@(GSUB sz src1 src2 dst)
1508 = pprG g (text "\t#GSUB-xxxcase1" $$
1509 hcat [gtab, gpush src2 0,
1510 text " ; fsubrp %st(0),", greg src1 1])
1512 = pprG g (text "\t#GSUB-xxxcase2" $$
1513 hcat [gtab, gpush src1 0,
1514 text " ; fsubp %st(0),", greg src2 1])
1516 = pprG g (hcat [gtab, gpush src1 0,
1517 text " ; fsub ", greg src2 1, text ",%st(0)",
1521 pprInstr g@(GDIV sz src1 src2 dst)
1523 = pprG g (text "\t#GDIV-xxxcase1" $$
1524 hcat [gtab, gpush src2 0,
1525 text " ; fdivrp %st(0),", greg src1 1])
1527 = pprG g (text "\t#GDIV-xxxcase2" $$
1528 hcat [gtab, gpush src1 0,
1529 text " ; fdivp %st(0),", greg src2 1])
1531 = pprG g (hcat [gtab, gpush src1 0,
1532 text " ; fdiv ", greg src2 1, text ",%st(0)",
1537 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1538 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1541 --------------------------
1543 -- coerce %st(0) to the specified size
1544 gcoerceto F64 = empty
1545 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1548 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1550 = hcat [text "fstp ", greg reg offset]
1552 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1557 gregno (RealReg i) = i
1558 gregno other = --pprPanic "gregno" (ppr other)
1559 999 -- bogus; only needed for debug printing
1561 pprG :: Instr -> Doc -> Doc
1563 = (char '#' <> pprGInstr fake) $$ actual
1565 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1566 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1567 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1569 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1570 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1572 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1573 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1575 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1576 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1578 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1579 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1580 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1581 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1582 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1583 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1584 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1586 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1587 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1588 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1589 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1592 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1594 -- Continue with I386-only printing bits and bobs:
1596 pprDollImm :: Imm -> Doc
1598 pprDollImm i = ptext SLIT("$") <> pprImm i
1600 pprOperand :: MachRep -> Operand -> Doc
1601 pprOperand s (OpReg r) = pprReg s r
1602 pprOperand s (OpImm i) = pprDollImm i
1603 pprOperand s (OpAddr ea) = pprAddr ea
1605 pprMnemonic_ :: LitString -> Doc
1607 char '\t' <> ptext name <> space
1609 pprMnemonic :: LitString -> MachRep -> Doc
1610 pprMnemonic name size =
1611 char '\t' <> ptext name <> pprSize size <> space
1613 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1614 pprSizeImmOp name size imm op1
1616 pprMnemonic name size,
1623 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1624 pprSizeOp name size op1
1626 pprMnemonic name size,
1630 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1631 pprSizeOpOp name size op1 op2
1633 pprMnemonic name size,
1634 pprOperand size op1,
1639 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1640 pprOpOp name size op1 op2
1643 pprOperand size op1,
1648 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1649 pprSizeReg name size reg1
1651 pprMnemonic name size,
1655 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1656 pprSizeRegReg name size reg1 reg2
1658 pprMnemonic name size,
1664 pprRegReg :: LitString -> Reg -> Reg -> Doc
1665 pprRegReg name reg1 reg2
1668 pprReg wordRep reg1,
1673 pprOpReg :: LitString -> Operand -> Reg -> Doc
1674 pprOpReg name op1 reg2
1677 pprOperand wordRep op1,
1682 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1683 pprCondRegReg name size cond reg1 reg2
1694 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1695 pprSizeSizeRegReg name size1 size2 reg1 reg2
1708 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1709 pprSizeRegRegReg name size reg1 reg2 reg3
1711 pprMnemonic name size,
1719 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1720 pprSizeAddrReg name size op dst
1722 pprMnemonic name size,
1728 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1729 pprSizeRegAddr name size src op
1731 pprMnemonic name size,
1737 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1738 pprShift name size src dest
1740 pprMnemonic name size,
1741 pprOperand I8 src, -- src is 8-bit sized
1743 pprOperand size dest
1746 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1747 pprSizeOpOpCoerce name size1 size2 op1 op2
1748 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1749 pprOperand size1 op1,
1751 pprOperand size2 op2
1754 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1755 pprCondInstr name cond arg
1756 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1758 #endif /* i386_TARGET_ARCH */
1761 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1763 #if sparc_TARGET_ARCH
1765 -- a clumsy hack for now, to handle possible double alignment problems
1767 -- even clumsier, to allow for RegReg regs that show when doing indexed
1768 -- reads (bytearrays).
1771 -- Translate to the following:
1774 -- ld [g1+4],%f(n+1)
1775 -- sub g1,g2,g1 -- to restore g1
1777 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1779 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1780 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1781 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1782 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1787 -- ld [addr+4],%f(n+1)
1788 pprInstr (LD F64 addr reg) | isJust off_addr
1790 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1791 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1794 off_addr = addrOffset addr 4
1795 addr2 = case off_addr of Just x -> x
1798 pprInstr (LD size addr reg)
1809 -- The same clumsy hack as above
1811 -- Translate to the following:
1814 -- st %f(n+1),[g1+4]
1815 -- sub g1,g2,g1 -- to restore g1
1816 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1818 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1819 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1821 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1822 pprReg g1, ptext SLIT("+4]")],
1823 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1828 -- st %f(n+1),[addr+4]
1829 pprInstr (ST F64 reg addr) | isJust off_addr
1831 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1832 pprAddr addr, rbrack],
1833 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1834 pprAddr addr2, rbrack]
1837 off_addr = addrOffset addr 4
1838 addr2 = case off_addr of Just x -> x
1840 -- no distinction is made between signed and unsigned bytes on stores for the
1841 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1842 -- so we call a special-purpose pprSize for ST..
1844 pprInstr (ST size reg addr)
1855 pprInstr (ADD x cc reg1 ri reg2)
1856 | not x && not cc && riZero ri
1857 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1859 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1861 pprInstr (SUB x cc reg1 ri reg2)
1862 | not x && cc && reg2 == g0
1863 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1864 | not x && not cc && riZero ri
1865 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1867 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1869 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1870 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1872 pprInstr (OR b reg1 ri reg2)
1873 | not b && reg1 == g0
1874 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1876 RIReg rrr | rrr == reg2 -> empty
1879 = pprRegRIReg SLIT("or") b reg1 ri reg2
1881 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1883 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1884 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1886 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1887 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1888 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1890 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1891 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1892 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1894 pprInstr (SETHI imm reg)
1896 ptext SLIT("\tsethi\t"),
1902 pprInstr NOP = ptext SLIT("\tnop")
1904 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1905 pprInstr (FABS F64 reg1 reg2)
1906 = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1907 (if (reg1 == reg2) then empty
1908 else (<>) (char '\n')
1909 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1911 pprInstr (FADD size reg1 reg2 reg3)
1912 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1913 pprInstr (FCMP e size reg1 reg2)
1914 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1915 pprInstr (FDIV size reg1 reg2 reg3)
1916 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1918 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1919 pprInstr (FMOV F64 reg1 reg2)
1920 = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1921 (if (reg1 == reg2) then empty
1922 else (<>) (char '\n')
1923 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1925 pprInstr (FMUL size reg1 reg2 reg3)
1926 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1928 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1929 pprInstr (FNEG F64 reg1 reg2)
1930 = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1931 (if (reg1 == reg2) then empty
1932 else (<>) (char '\n')
1933 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1935 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1936 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1937 pprInstr (FxTOy size1 size2 reg1 reg2)
1944 F64 -> SLIT("dto")),
1949 F64 -> SLIT("d\t")),
1950 pprReg reg1, comma, pprReg reg2
1954 pprInstr (BI cond b lab)
1956 ptext SLIT("\tb"), pprCond cond,
1957 if b then pp_comma_a else empty,
1962 pprInstr (BF cond b lab)
1964 ptext SLIT("\tfb"), pprCond cond,
1965 if b then pp_comma_a else empty,
1970 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1972 pprInstr (CALL (Left imm) n _)
1973 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1974 pprInstr (CALL (Right reg) n _)
1975 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1978 pprRI (RIReg r) = pprReg r
1979 pprRI (RIImm r) = pprImm r
1981 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1982 pprSizeRegReg name size reg1 reg2
1987 F32 -> ptext SLIT("s\t")
1988 F64 -> ptext SLIT("d\t")),
1994 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1995 pprSizeRegRegReg name size reg1 reg2 reg3
2000 F32 -> ptext SLIT("s\t")
2001 F64 -> ptext SLIT("d\t")),
2009 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2010 pprRegRIReg name b reg1 ri reg2
2014 if b then ptext SLIT("cc\t") else char '\t',
2022 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2023 pprRIReg name b ri reg1
2027 if b then ptext SLIT("cc\t") else char '\t',
2033 pp_ld_lbracket = ptext SLIT("\tld\t[")
2034 pp_rbracket_comma = text "],"
2035 pp_comma_lbracket = text ",["
2036 pp_comma_a = text ",a"
2038 #endif /* sparc_TARGET_ARCH */
2041 -- -----------------------------------------------------------------------------
2042 -- pprInstr for PowerPC
2044 #if powerpc_TARGET_ARCH
2045 pprInstr (LD sz reg addr) = hcat [
2054 case addr of AddrRegImm _ _ -> empty
2055 AddrRegReg _ _ -> char 'x',
2061 pprInstr (LA sz reg addr) = hcat [
2070 case addr of AddrRegImm _ _ -> empty
2071 AddrRegReg _ _ -> char 'x',
2077 pprInstr (ST sz reg addr) = hcat [
2081 case addr of AddrRegImm _ _ -> empty
2082 AddrRegReg _ _ -> char 'x',
2088 pprInstr (STU sz reg addr) = hcat [
2093 case addr of AddrRegImm _ _ -> empty
2094 AddrRegReg _ _ -> char 'x',
2099 pprInstr (LIS reg imm) = hcat [
2107 pprInstr (LI reg imm) = hcat [
2115 pprInstr (MR reg1 reg2)
2116 | reg1 == reg2 = empty
2117 | otherwise = hcat [
2119 case regClass reg1 of
2120 RcInteger -> ptext SLIT("mr")
2121 _ -> ptext SLIT("fmr"),
2127 pprInstr (CMP sz reg ri) = hcat [
2143 pprInstr (CMPL sz reg ri) = hcat [
2159 pprInstr (BCC cond (BlockId id)) = hcat [
2166 where lbl = mkAsmTempLabel id
2168 pprInstr (BCCFAR cond (BlockId id)) = vcat [
2171 pprCond (condNegate cond),
2175 ptext SLIT("\tb\t"),
2179 where lbl = mkAsmTempLabel id
2181 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2188 pprInstr (MTCTR reg) = hcat [
2190 ptext SLIT("mtctr"),
2194 pprInstr (BCTR _) = hcat [
2198 pprInstr (BL lbl _) = hcat [
2199 ptext SLIT("\tbl\t"),
2202 pprInstr (BCTRL _) = hcat [
2206 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2207 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2209 ptext SLIT("addis"),
2218 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2219 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2220 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2221 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2222 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2223 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2224 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2226 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2227 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2228 pprReg reg2, ptext SLIT(", "),
2230 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2231 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2232 pprReg reg1, ptext SLIT(", "),
2233 ptext SLIT("2, 31, 31") ]
2236 -- for some reason, "andi" doesn't exist.
2237 -- we'll use "andi." instead.
2238 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2240 ptext SLIT("andi."),
2248 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2250 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2251 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2253 pprInstr (XORIS reg1 reg2 imm) = hcat [
2255 ptext SLIT("xoris"),
2264 pprInstr (EXTS sz reg1 reg2) = hcat [
2274 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2275 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2277 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2278 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2279 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2280 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2281 ptext SLIT("\trlwinm\t"),
2293 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2294 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2295 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2296 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2297 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2299 pprInstr (FCMP reg1 reg2) = hcat [
2301 ptext SLIT("fcmpu\tcr0, "),
2302 -- Note: we're using fcmpu, not fcmpo
2303 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2304 -- We don't handle invalid fp ops, so we don't care
2310 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2311 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2313 pprInstr (CRNOR dst src1 src2) = hcat [
2314 ptext SLIT("\tcrnor\t"),
2322 pprInstr (MFCR reg) = hcat [
2329 pprInstr (MFLR reg) = hcat [
2336 pprInstr (FETCHPC reg) = vcat [
2337 ptext SLIT("\tbcl\t20,31,1f"),
2338 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2341 pprInstr LWSYNC = ptext SLIT("\tlwsync")
2343 pprInstr _ = panic "pprInstr (ppc)"
2345 pprLogic op reg1 reg2 ri = hcat [
2350 RIImm _ -> char 'i',
2359 pprUnary op reg1 reg2 = hcat [
2368 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2381 pprRI (RIReg r) = pprReg r
2382 pprRI (RIImm r) = pprImm r
2384 pprFSize F64 = empty
2385 pprFSize F32 = char 's'
2387 -- limit immediate argument for shift instruction to range 0..32
2388 -- (yes, the maximum is really 32, not 31)
2389 limitShiftRI :: RI -> RI
2390 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2393 #endif /* powerpc_TARGET_ARCH */
2396 -- -----------------------------------------------------------------------------
2397 -- Converting floating-point literals to integrals for printing
2399 castFloatToWord8Array :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2400 castFloatToWord8Array = castSTUArray
2402 castDoubleToWord8Array :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2403 castDoubleToWord8Array = castSTUArray
2405 -- floatToBytes and doubleToBytes convert to the host's byte
2406 -- order. Providing that we're not cross-compiling for a
2407 -- target with the opposite endianness, this should work ok
2410 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2411 -- could they be merged?
2413 floatToBytes :: Float -> [Int]
2416 arr <- newArray_ ((0::Int),3)
2418 arr <- castFloatToWord8Array arr
2419 i0 <- readArray arr 0
2420 i1 <- readArray arr 1
2421 i2 <- readArray arr 2
2422 i3 <- readArray arr 3
2423 return (map fromIntegral [i0,i1,i2,i3])
2426 doubleToBytes :: Double -> [Int]
2429 arr <- newArray_ ((0::Int),7)
2431 arr <- castDoubleToWord8Array arr
2432 i0 <- readArray arr 0
2433 i1 <- readArray arr 1
2434 i2 <- readArray arr 2
2435 i3 <- readArray arr 3
2436 i4 <- readArray arr 4
2437 i5 <- readArray arr 5
2438 i6 <- readArray arr 6
2439 i7 <- readArray arr 7
2440 return (map fromIntegral [i0,i1,i2,i3,i4,i5,i6,i7])