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
40 import StaticFlags ( opt_PIC, opt_Static )
42 #if __GLASGOW_HASKELL__ >= 504
44 import Data.Word ( Word8 )
50 import Char ( chr, ord )
51 import Maybe ( isJust )
53 #if powerpc_TARGET_ARCH
54 import DATA_WORD(Word32)
58 -- -----------------------------------------------------------------------------
59 -- Printing this stuff out
61 asmSDoc d = Outputable.withPprStyleDoc (
62 Outputable.mkCodeStyle Outputable.AsmStyle) d
63 pprCLabel_asm l = asmSDoc (pprCLabel l)
65 pprNatCmmTop :: NatCmmTop -> Doc
66 pprNatCmmTop (CmmData section dats) =
67 pprSectionHeader section $$ vcat (map pprData dats)
69 -- special case for split markers:
70 pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
72 pprNatCmmTop (CmmProc info lbl params blocks) =
73 pprSectionHeader Text $$
76 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
77 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
80 vcat (map pprData info) $$
81 pprLabel (entryLblToInfoLbl lbl)
85 (BasicBlock _ instrs : rest) ->
86 (if null info then pprLabel lbl else empty) $$
87 -- the first block doesn't get a label:
88 vcat (map pprInstr instrs) $$
89 vcat (map pprBasicBlock rest)
91 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
92 -- If we are using the .subsections_via_symbols directive
93 -- (available on recent versions of Darwin),
94 -- we have to make sure that there is some kind of reference
95 -- from the entry code to a label on the _top_ of of the info table,
96 -- so that the linker will not think it is unreferenced and dead-strip
97 -- it. That's why the label is called a DeadStripPreventer (_dsp).
100 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
102 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
107 pprBasicBlock :: NatBasicBlock -> Doc
108 pprBasicBlock (BasicBlock (BlockId id) instrs) =
109 pprLabel (mkAsmTempLabel id) $$
110 vcat (map pprInstr instrs)
112 -- -----------------------------------------------------------------------------
113 -- pprReg: print a 'Reg'
115 -- For x86, the way we print a register name depends
116 -- on which bit of it we care about. Yurgh.
118 pprUserReg :: Reg -> Doc
119 pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
121 pprReg :: IF_ARCH_i386(MachRep ->,) IF_ARCH_x86_64(MachRep ->,) Reg -> Doc
123 pprReg IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) r
125 RealReg i -> ppr_reg_no IF_ARCH_i386(s,) IF_ARCH_x86_64(s,) i
126 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
127 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
128 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
129 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
131 #if alpha_TARGET_ARCH
132 ppr_reg_no :: Int -> Doc
135 0 -> SLIT("$0"); 1 -> SLIT("$1");
136 2 -> SLIT("$2"); 3 -> SLIT("$3");
137 4 -> SLIT("$4"); 5 -> SLIT("$5");
138 6 -> SLIT("$6"); 7 -> SLIT("$7");
139 8 -> SLIT("$8"); 9 -> SLIT("$9");
140 10 -> SLIT("$10"); 11 -> SLIT("$11");
141 12 -> SLIT("$12"); 13 -> SLIT("$13");
142 14 -> SLIT("$14"); 15 -> SLIT("$15");
143 16 -> SLIT("$16"); 17 -> SLIT("$17");
144 18 -> SLIT("$18"); 19 -> SLIT("$19");
145 20 -> SLIT("$20"); 21 -> SLIT("$21");
146 22 -> SLIT("$22"); 23 -> SLIT("$23");
147 24 -> SLIT("$24"); 25 -> SLIT("$25");
148 26 -> SLIT("$26"); 27 -> SLIT("$27");
149 28 -> SLIT("$28"); 29 -> SLIT("$29");
150 30 -> SLIT("$30"); 31 -> SLIT("$31");
151 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
152 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
153 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
154 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
155 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
156 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
157 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
158 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
159 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
160 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
161 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
162 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
163 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
164 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
165 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
166 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
167 _ -> SLIT("very naughty alpha register")
171 ppr_reg_no :: MachRep -> Int -> Doc
172 ppr_reg_no I8 = ppr_reg_byte
173 ppr_reg_no I16 = ppr_reg_word
174 ppr_reg_no _ = ppr_reg_long
176 ppr_reg_byte i = ptext
178 0 -> SLIT("%al"); 1 -> SLIT("%bl");
179 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
180 _ -> SLIT("very naughty I386 byte register")
183 ppr_reg_word i = ptext
185 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
186 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
187 4 -> SLIT("%si"); 5 -> SLIT("%di");
188 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
189 _ -> SLIT("very naughty I386 word register")
192 ppr_reg_long i = ptext
194 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
195 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
196 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
197 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
198 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
199 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
200 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
201 _ -> SLIT("very naughty I386 register")
205 #if x86_64_TARGET_ARCH
206 ppr_reg_no :: MachRep -> Int -> Doc
207 ppr_reg_no I8 = ppr_reg_byte
208 ppr_reg_no I16 = ppr_reg_word
209 ppr_reg_no I32 = ppr_reg_long
210 ppr_reg_no _ = ppr_reg_quad
212 ppr_reg_byte i = ptext
214 0 -> SLIT("%al"); 1 -> SLIT("%bl");
215 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
216 4 -> SLIT("%sil"); 5 -> SLIT("%dil"); -- new 8-bit regs!
217 6 -> SLIT("%bpl"); 7 -> SLIT("%spl");
218 8 -> SLIT("%r8b"); 9 -> SLIT("%r9b");
219 10 -> SLIT("%r10b"); 11 -> SLIT("%r11b");
220 12 -> SLIT("%r12b"); 13 -> SLIT("%r13b");
221 14 -> SLIT("%r14b"); 15 -> SLIT("%r15b");
222 _ -> SLIT("very naughty x86_64 byte register")
225 ppr_reg_word i = ptext
227 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
228 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
229 4 -> SLIT("%si"); 5 -> SLIT("%di");
230 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
231 8 -> SLIT("%r8w"); 9 -> SLIT("%r9w");
232 10 -> SLIT("%r10w"); 11 -> SLIT("%r11w");
233 12 -> SLIT("%r12w"); 13 -> SLIT("%r13w");
234 14 -> SLIT("%r14w"); 15 -> SLIT("%r15w");
235 _ -> SLIT("very naughty x86_64 word register")
238 ppr_reg_long i = ptext
240 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
241 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
242 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
243 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
244 8 -> SLIT("%r8d"); 9 -> SLIT("%r9d");
245 10 -> SLIT("%r10d"); 11 -> SLIT("%r11d");
246 12 -> SLIT("%r12d"); 13 -> SLIT("%r13d");
247 14 -> SLIT("%r14d"); 15 -> SLIT("%r15d");
248 _ -> SLIT("very naughty x86_64 register")
251 ppr_reg_quad i = ptext
253 0 -> SLIT("%rax"); 1 -> SLIT("%rbx");
254 2 -> SLIT("%rcx"); 3 -> SLIT("%rdx");
255 4 -> SLIT("%rsi"); 5 -> SLIT("%rdi");
256 6 -> SLIT("%rbp"); 7 -> SLIT("%rsp");
257 8 -> SLIT("%r8"); 9 -> SLIT("%r9");
258 10 -> SLIT("%r10"); 11 -> SLIT("%r11");
259 12 -> SLIT("%r12"); 13 -> SLIT("%r13");
260 14 -> SLIT("%r14"); 15 -> SLIT("%r15");
261 16 -> SLIT("%xmm0"); 17 -> SLIT("%xmm1");
262 18 -> SLIT("%xmm2"); 19 -> SLIT("%xmm3");
263 20 -> SLIT("%xmm4"); 21 -> SLIT("%xmm5");
264 22 -> SLIT("%xmm6"); 23 -> SLIT("%xmm7");
265 24 -> SLIT("%xmm8"); 25 -> SLIT("%xmm9");
266 26 -> SLIT("%xmm10"); 27 -> SLIT("%xmm11");
267 28 -> SLIT("%xmm12"); 29 -> SLIT("%xmm13");
268 30 -> SLIT("%xmm14"); 31 -> SLIT("%xmm15");
269 _ -> SLIT("very naughty x86_64 register")
273 #if sparc_TARGET_ARCH
274 ppr_reg_no :: Int -> Doc
277 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
278 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
279 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
280 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
281 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
282 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
283 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
284 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
285 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
286 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
287 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
288 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
289 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
290 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
291 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
292 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
293 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
294 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
295 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
296 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
297 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
298 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
299 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
300 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
301 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
302 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
303 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
304 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
305 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
306 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
307 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
308 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
309 _ -> SLIT("very naughty sparc register")
312 #if powerpc_TARGET_ARCH
314 ppr_reg_no :: Int -> Doc
317 0 -> SLIT("r0"); 1 -> SLIT("r1");
318 2 -> SLIT("r2"); 3 -> SLIT("r3");
319 4 -> SLIT("r4"); 5 -> SLIT("r5");
320 6 -> SLIT("r6"); 7 -> SLIT("r7");
321 8 -> SLIT("r8"); 9 -> SLIT("r9");
322 10 -> SLIT("r10"); 11 -> SLIT("r11");
323 12 -> SLIT("r12"); 13 -> SLIT("r13");
324 14 -> SLIT("r14"); 15 -> SLIT("r15");
325 16 -> SLIT("r16"); 17 -> SLIT("r17");
326 18 -> SLIT("r18"); 19 -> SLIT("r19");
327 20 -> SLIT("r20"); 21 -> SLIT("r21");
328 22 -> SLIT("r22"); 23 -> SLIT("r23");
329 24 -> SLIT("r24"); 25 -> SLIT("r25");
330 26 -> SLIT("r26"); 27 -> SLIT("r27");
331 28 -> SLIT("r28"); 29 -> SLIT("r29");
332 30 -> SLIT("r30"); 31 -> SLIT("r31");
333 32 -> SLIT("f0"); 33 -> SLIT("f1");
334 34 -> SLIT("f2"); 35 -> SLIT("f3");
335 36 -> SLIT("f4"); 37 -> SLIT("f5");
336 38 -> SLIT("f6"); 39 -> SLIT("f7");
337 40 -> SLIT("f8"); 41 -> SLIT("f9");
338 42 -> SLIT("f10"); 43 -> SLIT("f11");
339 44 -> SLIT("f12"); 45 -> SLIT("f13");
340 46 -> SLIT("f14"); 47 -> SLIT("f15");
341 48 -> SLIT("f16"); 49 -> SLIT("f17");
342 50 -> SLIT("f18"); 51 -> SLIT("f19");
343 52 -> SLIT("f20"); 53 -> SLIT("f21");
344 54 -> SLIT("f22"); 55 -> SLIT("f23");
345 56 -> SLIT("f24"); 57 -> SLIT("f25");
346 58 -> SLIT("f26"); 59 -> SLIT("f27");
347 60 -> SLIT("f28"); 61 -> SLIT("f29");
348 62 -> SLIT("f30"); 63 -> SLIT("f31");
349 _ -> SLIT("very naughty powerpc register")
352 ppr_reg_no :: Int -> Doc
353 ppr_reg_no i | i <= 31 = int i -- GPRs
354 | i <= 63 = int (i-32) -- FPRs
355 | otherwise = ptext SLIT("very naughty powerpc register")
360 -- -----------------------------------------------------------------------------
361 -- pprSize: print a 'Size'
363 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH || sparc_TARGET_ARCH
364 pprSize :: MachRep -> Doc
366 pprSize :: Size -> Doc
369 pprSize x = ptext (case x of
370 #if alpha_TARGET_ARCH
373 -- W -> SLIT("w") UNUSED
374 -- Wu -> SLIT("wu") UNUSED
377 -- FF -> SLIT("f") UNUSED
378 -- DF -> SLIT("d") UNUSED
379 -- GF -> SLIT("g") UNUSED
380 -- SF -> SLIT("s") UNUSED
383 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
394 #if x86_64_TARGET_ARCH
395 F32 -> SLIT("ss") -- "scalar single-precision float" (SSE2)
396 F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2)
398 #if sparc_TARGET_ARCH
405 pprStSize :: MachRep -> Doc
406 pprStSize x = ptext (case x of
413 #if powerpc_TARGET_ARCH
422 -- -----------------------------------------------------------------------------
423 -- pprCond: print a 'Cond'
425 pprCond :: Cond -> Doc
427 pprCond c = ptext (case c of {
428 #if alpha_TARGET_ARCH
438 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
439 GEU -> SLIT("ae"); LU -> SLIT("b");
440 EQQ -> SLIT("e"); GTT -> SLIT("g");
441 GE -> SLIT("ge"); GU -> SLIT("a");
442 LTT -> SLIT("l"); LE -> SLIT("le");
443 LEU -> SLIT("be"); NE -> SLIT("ne");
444 NEG -> SLIT("s"); POS -> SLIT("ns");
445 CARRY -> SLIT("c"); OFLO -> SLIT("o");
446 PARITY -> SLIT("p"); NOTPARITY -> SLIT("np");
447 ALWAYS -> SLIT("mp") -- hack
449 #if sparc_TARGET_ARCH
450 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
451 GEU -> SLIT("geu"); LU -> SLIT("lu");
452 EQQ -> SLIT("e"); GTT -> SLIT("g");
453 GE -> SLIT("ge"); GU -> SLIT("gu");
454 LTT -> SLIT("l"); LE -> SLIT("le");
455 LEU -> SLIT("leu"); NE -> SLIT("ne");
456 NEG -> SLIT("neg"); POS -> SLIT("pos");
457 VC -> SLIT("vc"); VS -> SLIT("vs")
459 #if powerpc_TARGET_ARCH
461 EQQ -> SLIT("eq"); NE -> SLIT("ne");
462 LTT -> SLIT("lt"); GE -> SLIT("ge");
463 GTT -> SLIT("gt"); LE -> SLIT("le");
464 LU -> SLIT("lt"); GEU -> SLIT("ge");
465 GU -> SLIT("gt"); LEU -> SLIT("le");
470 -- -----------------------------------------------------------------------------
471 -- pprImm: print an 'Imm'
475 pprImm (ImmInt i) = int i
476 pprImm (ImmInteger i) = integer i
477 pprImm (ImmCLbl l) = pprCLabel_asm l
478 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
479 pprImm (ImmLit s) = s
481 pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
482 pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
484 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
485 #if sparc_TARGET_ARCH
486 -- ToDo: This should really be fixed in the PIC support, but only
488 pprImm (ImmConstantDiff a b) = pprImm a
490 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
491 <> lparen <> pprImm b <> rparen
494 #if sparc_TARGET_ARCH
496 = hcat [ pp_lo, pprImm i, rparen ]
501 = hcat [ pp_hi, pprImm i, rparen ]
505 #if powerpc_TARGET_ARCH
508 = hcat [ pp_lo, pprImm i, rparen ]
513 = hcat [ pp_hi, pprImm i, rparen ]
518 = hcat [ pp_ha, pprImm i, rparen ]
524 = pprImm i <> text "@l"
527 = pprImm i <> text "@h"
530 = pprImm i <> text "@ha"
535 -- -----------------------------------------------------------------------------
536 -- @pprAddr: print an 'AddrMode'
538 pprAddr :: AddrMode -> Doc
540 #if alpha_TARGET_ARCH
541 pprAddr (AddrReg r) = parens (pprReg r)
542 pprAddr (AddrImm i) = pprImm i
543 pprAddr (AddrRegImm r1 i)
544 = (<>) (pprImm i) (parens (pprReg r1))
549 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
550 pprAddr (ImmAddr imm off)
551 = let pp_imm = pprImm imm
555 else if (off < 0) then
558 pp_imm <> char '+' <> int off
560 pprAddr (AddrBaseIndex base index displacement)
562 pp_disp = ppr_disp displacement
563 pp_off p = pp_disp <> char '(' <> p <> char ')'
564 pp_reg r = pprReg wordRep r
567 (EABaseNone, EAIndexNone) -> pp_disp
568 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
569 (EABaseRip, EAIndexNone) -> pp_off (ptext SLIT("%rip"))
570 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
571 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
574 ppr_disp (ImmInt 0) = empty
575 ppr_disp imm = pprImm imm
580 #if sparc_TARGET_ARCH
581 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
583 pprAddr (AddrRegReg r1 r2)
584 = hcat [ pprReg r1, char '+', pprReg r2 ]
586 pprAddr (AddrRegImm r1 (ImmInt i))
588 | not (fits13Bits i) = largeOffsetError i
589 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
591 pp_sign = if i > 0 then char '+' else empty
593 pprAddr (AddrRegImm r1 (ImmInteger i))
595 | not (fits13Bits i) = largeOffsetError i
596 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
598 pp_sign = if i > 0 then char '+' else empty
600 pprAddr (AddrRegImm r1 imm)
601 = hcat [ pprReg r1, char '+', pprImm imm ]
606 #if powerpc_TARGET_ARCH
607 pprAddr (AddrRegReg r1 r2)
608 = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
610 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
611 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
612 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
616 -- -----------------------------------------------------------------------------
617 -- pprData: print a 'CmmStatic'
619 pprSectionHeader Text
621 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
622 ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
623 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".text\n\t.align 2"),
624 SLIT(".text\n\t.align 4,0x90"))
625 {-needs per-OS variation!-}
626 ,IF_ARCH_x86_64(SLIT(".text\n\t.align 8") {-needs per-OS variation!-}
627 ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
629 pprSectionHeader Data
631 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
632 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
633 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".data\n\t.align 2"),
634 SLIT(".data\n\t.align 4"))
635 ,IF_ARCH_x86_64(SLIT(".data\n\t.align 8")
636 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
638 pprSectionHeader ReadOnlyData
640 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
641 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
642 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 2"),
643 SLIT(".section .rodata\n\t.align 4"))
644 ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
645 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
646 SLIT(".section .rodata\n\t.align 2"))
648 pprSectionHeader RelocatableReadOnlyData
650 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
651 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
652 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n.align 2"),
653 SLIT(".section .rodata\n\t.align 4"))
654 ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
655 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
656 SLIT(".data\n\t.align 2"))
658 pprSectionHeader UninitialisedData
660 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
661 ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
662 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const_data\n\t.align 2"),
663 SLIT(".section .bss\n\t.align 4"))
664 ,IF_ARCH_x86_64(SLIT(".section .bss\n\t.align 8")
665 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
666 SLIT(".section .bss\n\t.align 2"))
668 pprSectionHeader ReadOnlyData16
670 IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
671 ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
672 ,IF_ARCH_i386(IF_OS_darwin(SLIT(".const\n.align 4"),
673 SLIT(".section .rodata\n\t.align 16"))
674 ,IF_ARCH_x86_64(SLIT(".section .rodata.cst16\n\t.align 16")
675 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
676 SLIT(".section .rodata\n\t.align 4"))
679 pprSectionHeader (OtherSection sec)
680 = panic "PprMach.pprSectionHeader: unknown section"
682 pprData :: CmmStatic -> Doc
683 pprData (CmmAlign bytes) = pprAlign bytes
684 pprData (CmmDataLabel lbl) = pprLabel lbl
685 pprData (CmmString str) = pprASCII str
686 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
687 pprData (CmmStaticLit lit) = pprDataItem lit
689 pprGloblDecl :: CLabel -> Doc
691 | not (externallyVisibleCLabel lbl) = empty
692 | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
696 pprLabel :: CLabel -> Doc
697 pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
701 = vcat (map do1 str) $$ do1 0
704 do1 w = ptext SLIT("\t.byte\t") <> int (fromIntegral w)
707 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
708 IF_ARCH_i386(ptext SLIT(".align ") <> int IF_OS_darwin(pow2,bytes),
709 IF_ARCH_x86_64(ptext SLIT(".align ") <> int bytes,
710 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
711 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
715 log2 :: Int -> Int -- cache the common ones
720 log2 n = 1 + log2 (n `quot` 2)
723 pprDataItem :: CmmLit -> Doc
725 = vcat (ppr_item (cmmLitRep lit) lit)
729 -- These seem to be common:
730 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
731 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
732 ppr_item F32 (CmmFloat r _)
733 = let bs = floatToBytes (fromRational r)
734 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
735 ppr_item F64 (CmmFloat r _)
736 = let bs = doubleToBytes (fromRational r)
737 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
739 #if sparc_TARGET_ARCH
740 -- copy n paste of x86 version
741 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
742 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
744 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
745 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
748 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
750 #if x86_64_TARGET_ARCH
751 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
752 -- type, which means we can't do pc-relative 64-bit addresses.
753 -- Fortunately we're assuming the small memory model, in which
754 -- all such offsets will fit into 32 bits, so we have to stick
755 -- to 32-bit offset fields and modify the RTS appropriately
756 -- (see InfoTables.h).
759 | isRelativeReloc x =
760 [ptext SLIT("\t.long\t") <> pprImm imm,
761 ptext SLIT("\t.long\t0")]
763 [ptext SLIT("\t.quad\t") <> pprImm imm]
765 isRelativeReloc (CmmLabelOff _ _) = True
766 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
767 isRelativeReloc _ = False
769 #if powerpc_TARGET_ARCH
770 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
771 ppr_item I64 (CmmInt x _) =
772 [ptext SLIT("\t.long\t")
774 (fromIntegral (x `shiftR` 32) :: Word32)),
775 ptext SLIT("\t.long\t")
776 <> int (fromIntegral (fromIntegral x :: Word32))]
779 -- fall through to rest of (machine-specific) pprInstr...
781 -- -----------------------------------------------------------------------------
782 -- pprInstr: print an 'Instr'
784 pprInstr :: Instr -> Doc
786 --pprInstr (COMMENT s) = empty -- nuke 'em
788 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
789 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
790 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
791 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
792 ,IF_ARCH_powerpc( IF_OS_linux(
793 ((<>) (ptext SLIT("# ")) (ftext s)),
794 ((<>) (ptext SLIT("; ")) (ftext s)))
798 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
800 pprInstr (NEWBLOCK _)
801 = panic "PprMach.pprInstr: NEWBLOCK"
804 = panic "PprMach.pprInstr: LDATA"
806 -- -----------------------------------------------------------------------------
807 -- pprInstr for an Alpha
809 #if alpha_TARGET_ARCH
811 pprInstr (LD size reg addr)
821 pprInstr (LDA reg addr)
823 ptext SLIT("\tlda\t"),
829 pprInstr (LDAH reg addr)
831 ptext SLIT("\tldah\t"),
837 pprInstr (LDGP reg addr)
839 ptext SLIT("\tldgp\t"),
845 pprInstr (LDI size reg imm)
855 pprInstr (ST size reg addr)
867 ptext SLIT("\tclr\t"),
871 pprInstr (ABS size ri reg)
881 pprInstr (NEG size ov ri reg)
885 if ov then ptext SLIT("v\t") else char '\t',
891 pprInstr (ADD size ov reg1 ri reg2)
895 if ov then ptext SLIT("v\t") else char '\t',
903 pprInstr (SADD size scale reg1 ri reg2)
905 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
916 pprInstr (SUB size ov reg1 ri reg2)
920 if ov then ptext SLIT("v\t") else char '\t',
928 pprInstr (SSUB size scale reg1 ri reg2)
930 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
941 pprInstr (MUL size ov reg1 ri reg2)
945 if ov then ptext SLIT("v\t") else char '\t',
953 pprInstr (DIV size uns reg1 ri reg2)
957 if uns then ptext SLIT("u\t") else char '\t',
965 pprInstr (REM size uns reg1 ri reg2)
969 if uns then ptext SLIT("u\t") else char '\t',
977 pprInstr (NOT ri reg)
986 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
987 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
988 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
989 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
990 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
991 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
993 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
994 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
995 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
997 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
998 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
1000 pprInstr (NOP) = ptext SLIT("\tnop")
1002 pprInstr (CMP cond reg1 ri reg2)
1004 ptext SLIT("\tcmp"),
1016 ptext SLIT("\tfclr\t"),
1020 pprInstr (FABS reg1 reg2)
1022 ptext SLIT("\tfabs\t"),
1028 pprInstr (FNEG size reg1 reg2)
1030 ptext SLIT("\tneg"),
1038 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1039 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1040 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1041 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1043 pprInstr (CVTxy size1 size2 reg1 reg2)
1045 ptext SLIT("\tcvt"),
1047 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1054 pprInstr (FCMP size cond reg1 reg2 reg3)
1056 ptext SLIT("\tcmp"),
1067 pprInstr (FMOV reg1 reg2)
1069 ptext SLIT("\tfmov\t"),
1075 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1077 pprInstr (BI NEVER reg lab) = empty
1079 pprInstr (BI cond reg lab)
1089 pprInstr (BF cond reg lab)
1100 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1102 pprInstr (JMP reg addr hint)
1104 ptext SLIT("\tjmp\t"),
1112 pprInstr (BSR imm n)
1113 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1115 pprInstr (JSR reg addr n)
1117 ptext SLIT("\tjsr\t"),
1123 pprInstr (FUNBEGIN clab)
1125 if (externallyVisibleCLabel clab) then
1126 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1129 ptext SLIT("\t.ent "),
1138 pp_lab = pprCLabel_asm clab
1140 -- NEVER use commas within those string literals, cpp will ruin your day
1141 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1142 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1143 ptext SLIT("4240"), char ',',
1144 ptext SLIT("$26"), char ',',
1145 ptext SLIT("0\n\t.prologue 1") ]
1147 pprInstr (FUNEND clab)
1148 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1151 Continue with Alpha-only printing bits and bobs:
1155 pprRI (RIReg r) = pprReg r
1156 pprRI (RIImm r) = pprImm r
1158 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1159 pprRegRIReg name reg1 ri reg2
1171 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1172 pprSizeRegRegReg name size reg1 reg2 reg3
1185 #endif /* alpha_TARGET_ARCH */
1188 -- -----------------------------------------------------------------------------
1189 -- pprInstr for an x86
1191 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1193 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1196 #if 0 /* #ifdef DEBUG */
1197 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1202 pprInstr (MOV size src dst)
1203 = pprSizeOpOp SLIT("mov") size src dst
1205 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1206 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1207 -- movl. But we represent it as a MOVZxL instruction, because
1208 -- the reg alloc would tend to throw away a plain reg-to-reg
1209 -- move, and we still want it to do that.
1211 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1212 -- zero-extension only needs to extend to 32 bits: on x86_64,
1213 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1214 -- instruction is shorter.
1216 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1218 -- here we do some patching, since the physical registers are only set late
1219 -- in the code generation.
1220 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1222 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1223 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1225 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1226 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1228 = pprInstr (ADD size (OpImm displ) dst)
1229 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1231 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1232 = pprSizeOp SLIT("dec") size dst
1233 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1234 = pprSizeOp SLIT("inc") size dst
1235 pprInstr (ADD size src dst)
1236 = pprSizeOpOp SLIT("add") size src dst
1237 pprInstr (ADC size src dst)
1238 = pprSizeOpOp SLIT("adc") size src dst
1239 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1240 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1242 {- A hack. The Intel documentation says that "The two and three
1243 operand forms [of IMUL] may also be used with unsigned operands
1244 because the lower half of the product is the same regardless if
1245 (sic) the operands are signed or unsigned. The CF and OF flags,
1246 however, cannot be used to determine if the upper half of the
1247 result is non-zero." So there.
1249 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1250 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1252 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1253 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1254 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1256 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1257 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1259 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1260 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1261 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1263 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1265 pprInstr (CMP size src dst)
1266 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1267 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1269 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1270 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1271 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1273 -- both unused (SDM):
1274 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1275 -- pprInstr POPA = ptext SLIT("\tpopal")
1277 pprInstr NOP = ptext SLIT("\tnop")
1278 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1279 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1281 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1283 pprInstr (JXX cond (BlockId id))
1284 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1285 where lab = mkAsmTempLabel id
1287 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1288 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1289 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1290 pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1291 pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1293 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1294 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1295 pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
1297 #if x86_64_TARGET_ARCH
1298 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1300 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1302 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1303 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1304 pprInstr (CVTSS2SI from to) = pprOpReg SLIT("cvtss2si") from to
1305 pprInstr (CVTSD2SI from to) = pprOpReg SLIT("cvtsd2si") from to
1306 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ss") from to
1307 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sd") from to
1310 -- FETCHGOT for PIC on ELF platforms
1311 pprInstr (FETCHGOT reg)
1312 = vcat [ ptext SLIT("\tcall 1f"),
1313 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1314 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1318 -- FETCHPC for PIC on Darwin/x86
1319 -- get the instruction pointer into a register
1320 -- (Terminology note: the IP is called Program Counter on PPC,
1321 -- and it's a good thing to use the same name on both platforms)
1322 pprInstr (FETCHPC reg)
1323 = vcat [ ptext SLIT("\tcall 1f"),
1324 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ]
1331 -- -----------------------------------------------------------------------------
1332 -- i386 floating-point
1334 #if i386_TARGET_ARCH
1335 -- Simulating a flat register set on the x86 FP stack is tricky.
1336 -- you have to free %st(7) before pushing anything on the FP reg stack
1337 -- so as to preclude the possibility of a FP stack overflow exception.
1338 pprInstr g@(GMOV src dst)
1342 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1344 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1345 pprInstr g@(GLD sz addr dst)
1346 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1347 pprAddr addr, gsemi, gpop dst 1])
1349 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1350 pprInstr g@(GST sz src addr)
1351 = pprG g (hcat [gtab, gpush src 0, gsemi,
1352 text "fstp", pprSize sz, gsp, pprAddr addr])
1354 pprInstr g@(GLDZ dst)
1355 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1356 pprInstr g@(GLD1 dst)
1357 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1359 pprInstr g@(GFTOI src dst)
1360 = pprInstr (GDTOI src dst)
1361 pprInstr g@(GDTOI src dst)
1362 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1363 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1366 pprInstr g@(GITOF src dst)
1367 = pprInstr (GITOD src dst)
1368 pprInstr g@(GITOD src dst)
1369 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1370 text " ; ffree %st(7); fildl (%esp) ; ",
1371 gpop dst 1, text " ; addl $4,%esp"])
1373 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1374 this far into the jungle AND you give a Rat's Ass (tm) what's going
1375 on, here's the deal. Generate code to do a floating point comparison
1376 of src1 and src2, of kind cond, and set the Zero flag if true.
1378 The complications are to do with handling NaNs correctly. We want the
1379 property that if either argument is NaN, then the result of the
1380 comparison is False ... except if we're comparing for inequality,
1381 in which case the answer is True.
1383 Here's how the general (non-inequality) case works. As an
1384 example, consider generating the an equality test:
1386 pushl %eax -- we need to mess with this
1387 <get src1 to top of FPU stack>
1388 fcomp <src2 location in FPU stack> and pop pushed src1
1389 -- Result of comparison is in FPU Status Register bits
1391 fstsw %ax -- Move FPU Status Reg to %ax
1392 sahf -- move C3 C2 C0 from %ax to integer flag reg
1393 -- now the serious magic begins
1394 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1395 sete %al -- %al = if arg1 == arg2 then 1 else 0
1396 andb %ah,%al -- %al &= %ah
1397 -- so %al == 1 iff (comparable && same); else it holds 0
1398 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1399 else %al == 0xFF, ZeroFlag=0
1400 -- the zero flag is now set as we desire.
1403 The special case of inequality differs thusly:
1405 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1406 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1407 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1408 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1409 else (%al == 0xFF, ZF=0)
1411 pprInstr g@(GCMP cond src1 src2)
1412 | case cond of { NE -> True; other -> False }
1414 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1415 hcat [gtab, text "fcomp ", greg src2 1,
1416 text "; fstsw %ax ; sahf ; setpe %ah"],
1417 hcat [gtab, text "setne %al ; ",
1418 text "orb %ah,%al ; decb %al ; popl %eax"]
1422 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1423 hcat [gtab, text "fcomp ", greg src2 1,
1424 text "; fstsw %ax ; sahf ; setpo %ah"],
1425 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1426 text "andb %ah,%al ; decb %al ; popl %eax"]
1429 {- On the 486, the flags set by FP compare are the unsigned ones!
1430 (This looks like a HACK to me. WDP 96/03)
1432 fix_FP_cond :: Cond -> Cond
1433 fix_FP_cond GE = GEU
1434 fix_FP_cond GTT = GU
1435 fix_FP_cond LTT = LU
1436 fix_FP_cond LE = LEU
1437 fix_FP_cond EQQ = EQQ
1439 -- there should be no others
1442 pprInstr g@(GABS sz src dst)
1443 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1444 pprInstr g@(GNEG sz src dst)
1445 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1447 pprInstr g@(GSQRT sz src dst)
1448 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1449 hcat [gtab, gcoerceto sz, gpop dst 1])
1450 pprInstr g@(GSIN sz src dst)
1451 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1452 hcat [gtab, gcoerceto sz, gpop dst 1])
1453 pprInstr g@(GCOS sz src dst)
1454 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1455 hcat [gtab, gcoerceto sz, gpop dst 1])
1456 pprInstr g@(GTAN sz src dst)
1457 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1458 gpush src 0, text " ; fptan ; ",
1459 text " fstp %st(0)"] $$
1460 hcat [gtab, gcoerceto sz, gpop dst 1])
1462 -- In the translations for GADD, GMUL, GSUB and GDIV,
1463 -- the first two cases are mere optimisations. The otherwise clause
1464 -- generates correct code under all circumstances.
1466 pprInstr g@(GADD sz src1 src2 dst)
1468 = pprG g (text "\t#GADD-xxxcase1" $$
1469 hcat [gtab, gpush src2 0,
1470 text " ; faddp %st(0),", greg src1 1])
1472 = pprG g (text "\t#GADD-xxxcase2" $$
1473 hcat [gtab, gpush src1 0,
1474 text " ; faddp %st(0),", greg src2 1])
1476 = pprG g (hcat [gtab, gpush src1 0,
1477 text " ; fadd ", greg src2 1, text ",%st(0)",
1481 pprInstr g@(GMUL sz src1 src2 dst)
1483 = pprG g (text "\t#GMUL-xxxcase1" $$
1484 hcat [gtab, gpush src2 0,
1485 text " ; fmulp %st(0),", greg src1 1])
1487 = pprG g (text "\t#GMUL-xxxcase2" $$
1488 hcat [gtab, gpush src1 0,
1489 text " ; fmulp %st(0),", greg src2 1])
1491 = pprG g (hcat [gtab, gpush src1 0,
1492 text " ; fmul ", greg src2 1, text ",%st(0)",
1496 pprInstr g@(GSUB sz src1 src2 dst)
1498 = pprG g (text "\t#GSUB-xxxcase1" $$
1499 hcat [gtab, gpush src2 0,
1500 text " ; fsubrp %st(0),", greg src1 1])
1502 = pprG g (text "\t#GSUB-xxxcase2" $$
1503 hcat [gtab, gpush src1 0,
1504 text " ; fsubp %st(0),", greg src2 1])
1506 = pprG g (hcat [gtab, gpush src1 0,
1507 text " ; fsub ", greg src2 1, text ",%st(0)",
1511 pprInstr g@(GDIV sz src1 src2 dst)
1513 = pprG g (text "\t#GDIV-xxxcase1" $$
1514 hcat [gtab, gpush src2 0,
1515 text " ; fdivrp %st(0),", greg src1 1])
1517 = pprG g (text "\t#GDIV-xxxcase2" $$
1518 hcat [gtab, gpush src1 0,
1519 text " ; fdivp %st(0),", greg src2 1])
1521 = pprG g (hcat [gtab, gpush src1 0,
1522 text " ; fdiv ", greg src2 1, text ",%st(0)",
1527 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1528 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1531 --------------------------
1533 -- coerce %st(0) to the specified size
1534 gcoerceto F64 = empty
1535 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1538 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1540 = hcat [text "fstp ", greg reg offset]
1542 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1547 gregno (RealReg i) = i
1548 gregno other = --pprPanic "gregno" (ppr other)
1549 999 -- bogus; only needed for debug printing
1551 pprG :: Instr -> Doc -> Doc
1553 = (char '#' <> pprGInstr fake) $$ actual
1555 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1556 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1557 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1559 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1560 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1562 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1563 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1565 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1566 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1568 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1569 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1570 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1571 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1572 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1573 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1574 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1576 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1577 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1578 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1579 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1582 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1584 -- Continue with I386-only printing bits and bobs:
1586 pprDollImm :: Imm -> Doc
1588 pprDollImm i = ptext SLIT("$") <> pprImm i
1590 pprOperand :: MachRep -> Operand -> Doc
1591 pprOperand s (OpReg r) = pprReg s r
1592 pprOperand s (OpImm i) = pprDollImm i
1593 pprOperand s (OpAddr ea) = pprAddr ea
1595 pprMnemonic_ :: LitString -> Doc
1597 char '\t' <> ptext name <> space
1599 pprMnemonic :: LitString -> MachRep -> Doc
1600 pprMnemonic name size =
1601 char '\t' <> ptext name <> pprSize size <> space
1603 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1604 pprSizeImmOp name size imm op1
1606 pprMnemonic name size,
1613 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1614 pprSizeOp name size op1
1616 pprMnemonic name size,
1620 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1621 pprSizeOpOp name size op1 op2
1623 pprMnemonic name size,
1624 pprOperand size op1,
1629 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1630 pprOpOp name size op1 op2
1633 pprOperand size op1,
1638 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1639 pprSizeReg name size reg1
1641 pprMnemonic name size,
1645 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1646 pprSizeRegReg name size reg1 reg2
1648 pprMnemonic name size,
1654 pprRegReg :: LitString -> Reg -> Reg -> Doc
1655 pprRegReg name reg1 reg2
1658 pprReg wordRep reg1,
1663 pprOpReg :: LitString -> Operand -> Reg -> Doc
1664 pprOpReg name op1 reg2
1667 pprOperand wordRep op1,
1672 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1673 pprCondRegReg name size cond reg1 reg2
1684 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1685 pprSizeSizeRegReg name size1 size2 reg1 reg2
1698 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1699 pprSizeRegRegReg name size reg1 reg2 reg3
1701 pprMnemonic name size,
1709 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1710 pprSizeAddrReg name size op dst
1712 pprMnemonic name size,
1718 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1719 pprSizeRegAddr name size src op
1721 pprMnemonic name size,
1727 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1728 pprShift name size src dest
1730 pprMnemonic name size,
1731 pprOperand I8 src, -- src is 8-bit sized
1733 pprOperand size dest
1736 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1737 pprSizeOpOpCoerce name size1 size2 op1 op2
1738 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1739 pprOperand size1 op1,
1741 pprOperand size2 op2
1744 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1745 pprCondInstr name cond arg
1746 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1748 #endif /* i386_TARGET_ARCH */
1751 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1753 #if sparc_TARGET_ARCH
1755 -- a clumsy hack for now, to handle possible double alignment problems
1757 -- even clumsier, to allow for RegReg regs that show when doing indexed
1758 -- reads (bytearrays).
1761 -- Translate to the following:
1764 -- ld [g1+4],%f(n+1)
1765 -- sub g1,g2,g1 -- to restore g1
1767 pprInstr (LD F64 (AddrRegReg g1 g2) reg)
1769 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1770 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1771 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1772 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1777 -- ld [addr+4],%f(n+1)
1778 pprInstr (LD F64 addr reg) | isJust off_addr
1780 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1781 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1784 off_addr = addrOffset addr 4
1785 addr2 = case off_addr of Just x -> x
1788 pprInstr (LD size addr reg)
1799 -- The same clumsy hack as above
1801 -- Translate to the following:
1804 -- st %f(n+1),[g1+4]
1805 -- sub g1,g2,g1 -- to restore g1
1806 pprInstr (ST F64 reg (AddrRegReg g1 g2))
1808 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1809 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1811 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1812 pprReg g1, ptext SLIT("+4]")],
1813 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1818 -- st %f(n+1),[addr+4]
1819 pprInstr (ST F64 reg addr) | isJust off_addr
1821 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1822 pprAddr addr, rbrack],
1823 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1824 pprAddr addr2, rbrack]
1827 off_addr = addrOffset addr 4
1828 addr2 = case off_addr of Just x -> x
1830 -- no distinction is made between signed and unsigned bytes on stores for the
1831 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1832 -- so we call a special-purpose pprSize for ST..
1834 pprInstr (ST size reg addr)
1845 pprInstr (ADD x cc reg1 ri reg2)
1846 | not x && not cc && riZero ri
1847 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1849 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1851 pprInstr (SUB x cc reg1 ri reg2)
1852 | not x && cc && reg2 == g0
1853 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1854 | not x && not cc && riZero ri
1855 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1857 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1859 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1860 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1862 pprInstr (OR b reg1 ri reg2)
1863 | not b && reg1 == g0
1864 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1866 RIReg rrr | rrr == reg2 -> empty
1869 = pprRegRIReg SLIT("or") b reg1 ri reg2
1871 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1873 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1874 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1876 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1877 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1878 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1880 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1881 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1882 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1884 pprInstr (SETHI imm reg)
1886 ptext SLIT("\tsethi\t"),
1892 pprInstr NOP = ptext SLIT("\tnop")
1894 pprInstr (FABS F32 reg1 reg2) = pprSizeRegReg SLIT("fabs") F32 reg1 reg2
1895 pprInstr (FABS F64 reg1 reg2)
1896 = (<>) (pprSizeRegReg SLIT("fabs") F32 reg1 reg2)
1897 (if (reg1 == reg2) then empty
1898 else (<>) (char '\n')
1899 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1901 pprInstr (FADD size reg1 reg2 reg3)
1902 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1903 pprInstr (FCMP e size reg1 reg2)
1904 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1905 pprInstr (FDIV size reg1 reg2 reg3)
1906 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1908 pprInstr (FMOV F32 reg1 reg2) = pprSizeRegReg SLIT("fmov") F32 reg1 reg2
1909 pprInstr (FMOV F64 reg1 reg2)
1910 = (<>) (pprSizeRegReg SLIT("fmov") F32 reg1 reg2)
1911 (if (reg1 == reg2) then empty
1912 else (<>) (char '\n')
1913 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1915 pprInstr (FMUL size reg1 reg2 reg3)
1916 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1918 pprInstr (FNEG F32 reg1 reg2) = pprSizeRegReg SLIT("fneg") F32 reg1 reg2
1919 pprInstr (FNEG F64 reg1 reg2)
1920 = (<>) (pprSizeRegReg SLIT("fneg") F32 reg1 reg2)
1921 (if (reg1 == reg2) then empty
1922 else (<>) (char '\n')
1923 (pprSizeRegReg SLIT("fmov") F32 (fPair reg1) (fPair reg2)))
1925 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1926 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1927 pprInstr (FxTOy size1 size2 reg1 reg2)
1934 F64 -> SLIT("dto")),
1939 F64 -> SLIT("d\t")),
1940 pprReg reg1, comma, pprReg reg2
1944 pprInstr (BI cond b lab)
1946 ptext SLIT("\tb"), pprCond cond,
1947 if b then pp_comma_a else empty,
1952 pprInstr (BF cond b lab)
1954 ptext SLIT("\tfb"), pprCond cond,
1955 if b then pp_comma_a else empty,
1960 pprInstr (JMP addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1962 pprInstr (CALL (Left imm) n _)
1963 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1964 pprInstr (CALL (Right reg) n _)
1965 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1968 pprRI (RIReg r) = pprReg r
1969 pprRI (RIImm r) = pprImm r
1971 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1972 pprSizeRegReg name size reg1 reg2
1977 F32 -> ptext SLIT("s\t")
1978 F64 -> ptext SLIT("d\t")),
1984 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1985 pprSizeRegRegReg name size reg1 reg2 reg3
1990 F32 -> ptext SLIT("s\t")
1991 F64 -> ptext SLIT("d\t")),
1999 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
2000 pprRegRIReg name b reg1 ri reg2
2004 if b then ptext SLIT("cc\t") else char '\t',
2012 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
2013 pprRIReg name b ri reg1
2017 if b then ptext SLIT("cc\t") else char '\t',
2023 pp_ld_lbracket = ptext SLIT("\tld\t[")
2024 pp_rbracket_comma = text "],"
2025 pp_comma_lbracket = text ",["
2026 pp_comma_a = text ",a"
2028 #endif /* sparc_TARGET_ARCH */
2031 -- -----------------------------------------------------------------------------
2032 -- pprInstr for PowerPC
2034 #if powerpc_TARGET_ARCH
2035 pprInstr (LD sz reg addr) = hcat [
2044 case addr of AddrRegImm _ _ -> empty
2045 AddrRegReg _ _ -> char 'x',
2051 pprInstr (LA sz reg addr) = hcat [
2060 case addr of AddrRegImm _ _ -> empty
2061 AddrRegReg _ _ -> char 'x',
2067 pprInstr (ST sz reg addr) = hcat [
2071 case addr of AddrRegImm _ _ -> empty
2072 AddrRegReg _ _ -> char 'x',
2078 pprInstr (STU sz reg addr) = hcat [
2083 case addr of AddrRegImm _ _ -> empty
2084 AddrRegReg _ _ -> char 'x',
2089 pprInstr (LIS reg imm) = hcat [
2097 pprInstr (LI reg imm) = hcat [
2105 pprInstr (MR reg1 reg2)
2106 | reg1 == reg2 = empty
2107 | otherwise = hcat [
2109 case regClass reg1 of
2110 RcInteger -> ptext SLIT("mr")
2111 _ -> ptext SLIT("fmr"),
2117 pprInstr (CMP sz reg ri) = hcat [
2133 pprInstr (CMPL sz reg ri) = hcat [
2149 pprInstr (BCC cond (BlockId id)) = hcat [
2156 where lbl = mkAsmTempLabel id
2158 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2165 pprInstr (MTCTR reg) = hcat [
2167 ptext SLIT("mtctr"),
2171 pprInstr (BCTR _) = hcat [
2175 pprInstr (BL lbl _) = hcat [
2176 ptext SLIT("\tbl\t"),
2179 pprInstr (BCTRL _) = hcat [
2183 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2184 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2186 ptext SLIT("addis"),
2195 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2196 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2197 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2198 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2199 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2200 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2201 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2203 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2204 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2205 pprReg reg2, ptext SLIT(", "),
2207 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2208 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2209 pprReg reg1, ptext SLIT(", "),
2210 ptext SLIT("2, 31, 31") ]
2213 -- for some reason, "andi" doesn't exist.
2214 -- we'll use "andi." instead.
2215 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2217 ptext SLIT("andi."),
2225 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2227 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2228 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2230 pprInstr (XORIS reg1 reg2 imm) = hcat [
2232 ptext SLIT("xoris"),
2241 pprInstr (EXTS sz reg1 reg2) = hcat [
2251 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2252 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2254 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2255 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2256 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2257 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2258 ptext SLIT("\trlwinm\t"),
2270 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2271 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2272 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2273 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2274 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2276 pprInstr (FCMP reg1 reg2) = hcat [
2278 ptext SLIT("fcmpu\tcr0, "),
2279 -- Note: we're using fcmpu, not fcmpo
2280 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2281 -- We don't handle invalid fp ops, so we don't care
2287 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2288 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2290 pprInstr (CRNOR dst src1 src2) = hcat [
2291 ptext SLIT("\tcrnor\t"),
2299 pprInstr (MFCR reg) = hcat [
2306 pprInstr (MFLR reg) = hcat [
2313 pprInstr (FETCHPC reg) = vcat [
2314 ptext SLIT("\tbcl\t20,31,1f"),
2315 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2318 pprInstr _ = panic "pprInstr (ppc)"
2320 pprLogic op reg1 reg2 ri = hcat [
2325 RIImm _ -> char 'i',
2334 pprUnary op reg1 reg2 = hcat [
2343 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2356 pprRI (RIReg r) = pprReg r
2357 pprRI (RIImm r) = pprImm r
2359 pprFSize F64 = empty
2360 pprFSize F32 = char 's'
2362 -- limit immediate argument for shift instruction to range 0..32
2363 -- (yes, the maximum is really 32, not 31)
2364 limitShiftRI :: RI -> RI
2365 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2368 #endif /* powerpc_TARGET_ARCH */
2371 -- -----------------------------------------------------------------------------
2372 -- Converting floating-point literals to integrals for printing
2374 #if __GLASGOW_HASKELL__ >= 504
2375 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
2376 newFloatArray = newArray_
2378 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
2379 newDoubleArray = newArray_
2381 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2382 castFloatToCharArray = castSTUArray
2384 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2385 castDoubleToCharArray = castSTUArray
2387 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
2388 writeFloatArray = writeArray
2390 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
2391 writeDoubleArray = writeArray
2393 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
2394 readCharArray arr i = do
2395 w <- readArray arr i
2396 return $! (chr (fromIntegral w))
2400 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2401 castFloatToCharArray = return
2403 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2406 castDoubleToCharArray = return
2410 -- floatToBytes and doubleToBytes convert to the host's byte
2411 -- order. Providing that we're not cross-compiling for a
2412 -- target with the opposite endianness, this should work ok
2415 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2416 -- could they be merged?
2418 floatToBytes :: Float -> [Int]
2421 arr <- newFloatArray ((0::Int),3)
2422 writeFloatArray arr 0 f
2423 arr <- castFloatToCharArray arr
2424 i0 <- readCharArray arr 0
2425 i1 <- readCharArray arr 1
2426 i2 <- readCharArray arr 2
2427 i3 <- readCharArray arr 3
2428 return (map ord [i0,i1,i2,i3])
2431 doubleToBytes :: Double -> [Int]
2434 arr <- newDoubleArray ((0::Int),7)
2435 writeDoubleArray arr 0 d
2436 arr <- castDoubleToCharArray arr
2437 i0 <- readCharArray arr 0
2438 i1 <- readCharArray arr 1
2439 i2 <- readCharArray arr 2
2440 i3 <- readCharArray arr 3
2441 i4 <- readCharArray arr 4
2442 i5 <- readCharArray arr 5
2443 i6 <- readCharArray arr 6
2444 i7 <- readCharArray arr 7
2445 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])