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 )
52 #if powerpc_TARGET_ARCH
53 import DATA_WORD(Word32)
57 -- -----------------------------------------------------------------------------
58 -- Printing this stuff out
60 asmSDoc d = Outputable.withPprStyleDoc (
61 Outputable.mkCodeStyle Outputable.AsmStyle) d
62 pprCLabel_asm l = asmSDoc (pprCLabel l)
64 pprNatCmmTop :: NatCmmTop -> Doc
65 pprNatCmmTop (CmmData section dats) =
66 pprSectionHeader section $$ vcat (map pprData dats)
68 -- special case for split markers:
69 pprNatCmmTop (CmmProc [] lbl _ []) = pprLabel lbl
71 pprNatCmmTop (CmmProc info lbl params blocks) =
72 pprSectionHeader Text $$
75 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
76 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
79 vcat (map pprData info) $$
80 pprLabel (entryLblToInfoLbl lbl)
84 (BasicBlock _ instrs : rest) ->
85 (if null info then pprLabel lbl else empty) $$
86 -- the first block doesn't get a label:
87 vcat (map pprInstr instrs) $$
88 vcat (map pprBasicBlock rest)
90 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
91 -- If we are using the .subsections_via_symbols directive
92 -- (available on recent versions of Darwin),
93 -- we have to make sure that there is some kind of reference
94 -- from the entry code to a label on the _top_ of of the info table,
95 -- so that the linker will not think it is unreferenced and dead-strip
96 -- it. That's why the label is called a DeadStripPreventer (_dsp).
99 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
101 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
106 pprBasicBlock :: NatBasicBlock -> Doc
107 pprBasicBlock (BasicBlock (BlockId id) instrs) =
108 pprLabel (mkAsmTempLabel id) $$
109 vcat (map pprInstr instrs)
111 -- -----------------------------------------------------------------------------
112 -- pprReg: print a 'Reg'
114 -- For x86, the way we print a register name depends
115 -- on which bit of it we care about. Yurgh.
117 pprUserReg :: Reg -> Doc
118 pprUserReg = pprReg IF_ARCH_i386(I32,) IF_ARCH_x86_64(I64,)
120 pprReg :: IF_ARCH_i386(MachRep ->, IF_ARCH_x86_64(MachRep ->,)) Reg -> Doc
122 pprReg IF_ARCH_i386(s, IF_ARCH_x86_64(s,)) r
124 RealReg i -> ppr_reg_no IF_ARCH_i386(s, IF_ARCH_x86_64(s,)) i
125 VirtualRegI u -> text "%vI_" <> asmSDoc (pprUnique u)
126 VirtualRegHi u -> text "%vHi_" <> asmSDoc (pprUnique u)
127 VirtualRegF u -> text "%vF_" <> asmSDoc (pprUnique u)
128 VirtualRegD u -> text "%vD_" <> asmSDoc (pprUnique u)
130 #if alpha_TARGET_ARCH
131 ppr_reg_no :: Int -> Doc
134 0 -> SLIT("$0"); 1 -> SLIT("$1");
135 2 -> SLIT("$2"); 3 -> SLIT("$3");
136 4 -> SLIT("$4"); 5 -> SLIT("$5");
137 6 -> SLIT("$6"); 7 -> SLIT("$7");
138 8 -> SLIT("$8"); 9 -> SLIT("$9");
139 10 -> SLIT("$10"); 11 -> SLIT("$11");
140 12 -> SLIT("$12"); 13 -> SLIT("$13");
141 14 -> SLIT("$14"); 15 -> SLIT("$15");
142 16 -> SLIT("$16"); 17 -> SLIT("$17");
143 18 -> SLIT("$18"); 19 -> SLIT("$19");
144 20 -> SLIT("$20"); 21 -> SLIT("$21");
145 22 -> SLIT("$22"); 23 -> SLIT("$23");
146 24 -> SLIT("$24"); 25 -> SLIT("$25");
147 26 -> SLIT("$26"); 27 -> SLIT("$27");
148 28 -> SLIT("$28"); 29 -> SLIT("$29");
149 30 -> SLIT("$30"); 31 -> SLIT("$31");
150 32 -> SLIT("$f0"); 33 -> SLIT("$f1");
151 34 -> SLIT("$f2"); 35 -> SLIT("$f3");
152 36 -> SLIT("$f4"); 37 -> SLIT("$f5");
153 38 -> SLIT("$f6"); 39 -> SLIT("$f7");
154 40 -> SLIT("$f8"); 41 -> SLIT("$f9");
155 42 -> SLIT("$f10"); 43 -> SLIT("$f11");
156 44 -> SLIT("$f12"); 45 -> SLIT("$f13");
157 46 -> SLIT("$f14"); 47 -> SLIT("$f15");
158 48 -> SLIT("$f16"); 49 -> SLIT("$f17");
159 50 -> SLIT("$f18"); 51 -> SLIT("$f19");
160 52 -> SLIT("$f20"); 53 -> SLIT("$f21");
161 54 -> SLIT("$f22"); 55 -> SLIT("$f23");
162 56 -> SLIT("$f24"); 57 -> SLIT("$f25");
163 58 -> SLIT("$f26"); 59 -> SLIT("$f27");
164 60 -> SLIT("$f28"); 61 -> SLIT("$f29");
165 62 -> SLIT("$f30"); 63 -> SLIT("$f31");
166 _ -> SLIT("very naughty alpha register")
170 ppr_reg_no :: MachRep -> Int -> Doc
171 ppr_reg_no I8 = ppr_reg_byte
172 ppr_reg_no I16 = ppr_reg_word
173 ppr_reg_no _ = ppr_reg_long
175 ppr_reg_byte i = ptext
177 0 -> SLIT("%al"); 1 -> SLIT("%bl");
178 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
179 _ -> SLIT("very naughty I386 byte register")
182 ppr_reg_word i = ptext
184 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
185 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
186 4 -> SLIT("%si"); 5 -> SLIT("%di");
187 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
188 _ -> SLIT("very naughty I386 word register")
191 ppr_reg_long i = ptext
193 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
194 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
195 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
196 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
197 8 -> SLIT("%fake0"); 9 -> SLIT("%fake1");
198 10 -> SLIT("%fake2"); 11 -> SLIT("%fake3");
199 12 -> SLIT("%fake4"); 13 -> SLIT("%fake5");
200 _ -> SLIT("very naughty I386 register")
204 #if x86_64_TARGET_ARCH
205 ppr_reg_no :: MachRep -> Int -> Doc
206 ppr_reg_no I8 = ppr_reg_byte
207 ppr_reg_no I16 = ppr_reg_word
208 ppr_reg_no I32 = ppr_reg_long
209 ppr_reg_no _ = ppr_reg_quad
211 ppr_reg_byte i = ptext
213 0 -> SLIT("%al"); 1 -> SLIT("%bl");
214 2 -> SLIT("%cl"); 3 -> SLIT("%dl");
215 4 -> SLIT("%sil"); 5 -> SLIT("%dil"); -- new 8-bit regs!
216 6 -> SLIT("%bpl"); 7 -> SLIT("%spl");
217 8 -> SLIT("%r8b"); 9 -> SLIT("%r9b");
218 10 -> SLIT("%r10b"); 11 -> SLIT("%r11b");
219 12 -> SLIT("%r12b"); 13 -> SLIT("%r13b");
220 14 -> SLIT("%r14b"); 15 -> SLIT("%r15b");
221 _ -> SLIT("very naughty x86_64 byte register")
224 ppr_reg_word i = ptext
226 0 -> SLIT("%ax"); 1 -> SLIT("%bx");
227 2 -> SLIT("%cx"); 3 -> SLIT("%dx");
228 4 -> SLIT("%si"); 5 -> SLIT("%di");
229 6 -> SLIT("%bp"); 7 -> SLIT("%sp");
230 8 -> SLIT("%r8w"); 9 -> SLIT("%r9w");
231 10 -> SLIT("%r10w"); 11 -> SLIT("%r11w");
232 12 -> SLIT("%r12w"); 13 -> SLIT("%r13w");
233 14 -> SLIT("%r14w"); 15 -> SLIT("%r15w");
234 _ -> SLIT("very naughty x86_64 word register")
237 ppr_reg_long i = ptext
239 0 -> SLIT("%eax"); 1 -> SLIT("%ebx");
240 2 -> SLIT("%ecx"); 3 -> SLIT("%edx");
241 4 -> SLIT("%esi"); 5 -> SLIT("%edi");
242 6 -> SLIT("%ebp"); 7 -> SLIT("%esp");
243 8 -> SLIT("%r8d"); 9 -> SLIT("%r9d");
244 10 -> SLIT("%r10d"); 11 -> SLIT("%r11d");
245 12 -> SLIT("%r12d"); 13 -> SLIT("%r13d");
246 14 -> SLIT("%r14d"); 15 -> SLIT("%r15d");
247 _ -> SLIT("very naughty x86_64 register")
250 ppr_reg_quad i = ptext
252 0 -> SLIT("%rax"); 1 -> SLIT("%rbx");
253 2 -> SLIT("%rcx"); 3 -> SLIT("%rdx");
254 4 -> SLIT("%rsi"); 5 -> SLIT("%rdi");
255 6 -> SLIT("%rbp"); 7 -> SLIT("%rsp");
256 8 -> SLIT("%r8"); 9 -> SLIT("%r9");
257 10 -> SLIT("%r10"); 11 -> SLIT("%r11");
258 12 -> SLIT("%r12"); 13 -> SLIT("%r13");
259 14 -> SLIT("%r14"); 15 -> SLIT("%r15");
260 16 -> SLIT("%xmm0"); 17 -> SLIT("%xmm1");
261 18 -> SLIT("%xmm2"); 19 -> SLIT("%xmm3");
262 20 -> SLIT("%xmm4"); 21 -> SLIT("%xmm5");
263 22 -> SLIT("%xmm6"); 23 -> SLIT("%xmm7");
264 24 -> SLIT("%xmm8"); 25 -> SLIT("%xmm9");
265 26 -> SLIT("%xmm10"); 27 -> SLIT("%xmm11");
266 28 -> SLIT("%xmm12"); 28 -> SLIT("%xmm13");
267 30 -> SLIT("%xmm13"); 31 -> SLIT("%xmm15")
271 #if sparc_TARGET_ARCH
272 ppr_reg_no :: Int -> Doc
275 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
276 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
277 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
278 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
279 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
280 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
281 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
282 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
283 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
284 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
285 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
286 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
287 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
288 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
289 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
290 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
291 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
292 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
293 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
294 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
295 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
296 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
297 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
298 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
299 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
300 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
301 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
302 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
303 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
304 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
305 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
306 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
307 _ -> SLIT("very naughty sparc register")
310 #if powerpc_TARGET_ARCH
312 ppr_reg_no :: Int -> Doc
315 0 -> SLIT("r0"); 1 -> SLIT("r1");
316 2 -> SLIT("r2"); 3 -> SLIT("r3");
317 4 -> SLIT("r4"); 5 -> SLIT("r5");
318 6 -> SLIT("r6"); 7 -> SLIT("r7");
319 8 -> SLIT("r8"); 9 -> SLIT("r9");
320 10 -> SLIT("r10"); 11 -> SLIT("r11");
321 12 -> SLIT("r12"); 13 -> SLIT("r13");
322 14 -> SLIT("r14"); 15 -> SLIT("r15");
323 16 -> SLIT("r16"); 17 -> SLIT("r17");
324 18 -> SLIT("r18"); 19 -> SLIT("r19");
325 20 -> SLIT("r20"); 21 -> SLIT("r21");
326 22 -> SLIT("r22"); 23 -> SLIT("r23");
327 24 -> SLIT("r24"); 25 -> SLIT("r25");
328 26 -> SLIT("r26"); 27 -> SLIT("r27");
329 28 -> SLIT("r28"); 29 -> SLIT("r29");
330 30 -> SLIT("r30"); 31 -> SLIT("r31");
331 32 -> SLIT("f0"); 33 -> SLIT("f1");
332 34 -> SLIT("f2"); 35 -> SLIT("f3");
333 36 -> SLIT("f4"); 37 -> SLIT("f5");
334 38 -> SLIT("f6"); 39 -> SLIT("f7");
335 40 -> SLIT("f8"); 41 -> SLIT("f9");
336 42 -> SLIT("f10"); 43 -> SLIT("f11");
337 44 -> SLIT("f12"); 45 -> SLIT("f13");
338 46 -> SLIT("f14"); 47 -> SLIT("f15");
339 48 -> SLIT("f16"); 49 -> SLIT("f17");
340 50 -> SLIT("f18"); 51 -> SLIT("f19");
341 52 -> SLIT("f20"); 53 -> SLIT("f21");
342 54 -> SLIT("f22"); 55 -> SLIT("f23");
343 56 -> SLIT("f24"); 57 -> SLIT("f25");
344 58 -> SLIT("f26"); 59 -> SLIT("f27");
345 60 -> SLIT("f28"); 61 -> SLIT("f29");
346 62 -> SLIT("f30"); 63 -> SLIT("f31");
347 _ -> SLIT("very naughty powerpc register")
350 ppr_reg_no :: Int -> Doc
351 ppr_reg_no i | i <= 31 = int i -- GPRs
352 | i <= 63 = int (i-32) -- FPRs
353 | otherwise = ptext SLIT("very naughty powerpc register")
358 -- -----------------------------------------------------------------------------
359 -- pprSize: print a 'Size'
361 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH
362 pprSize :: MachRep -> Doc
364 pprSize :: Size -> Doc
367 pprSize x = ptext (case x of
368 #if alpha_TARGET_ARCH
371 -- W -> SLIT("w") UNUSED
372 -- Wu -> SLIT("wu") UNUSED
375 -- FF -> SLIT("f") UNUSED
376 -- DF -> SLIT("d") UNUSED
377 -- GF -> SLIT("g") UNUSED
378 -- SF -> SLIT("s") UNUSED
381 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
392 #if x86_64_TARGET_ARCH
393 F32 -> SLIT("ss") -- "scalar single-precision float" (SSE2)
394 F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2)
396 #if sparc_TARGET_ARCH
405 pprStSize :: Size -> Doc
406 pprStSize x = ptext (case x of
415 #if powerpc_TARGET_ARCH
424 -- -----------------------------------------------------------------------------
425 -- pprCond: print a 'Cond'
427 pprCond :: Cond -> Doc
429 pprCond c = ptext (case c of {
430 #if alpha_TARGET_ARCH
440 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
441 GEU -> SLIT("ae"); LU -> SLIT("b");
442 EQQ -> SLIT("e"); GTT -> SLIT("g");
443 GE -> SLIT("ge"); GU -> SLIT("a");
444 LTT -> SLIT("l"); LE -> SLIT("le");
445 LEU -> SLIT("be"); NE -> SLIT("ne");
446 NEG -> SLIT("s"); POS -> SLIT("ns");
447 CARRY -> SLIT("c"); OFLO -> SLIT("o");
448 ALWAYS -> SLIT("mp") -- hack
450 #if sparc_TARGET_ARCH
451 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
452 GEU -> SLIT("geu"); LU -> SLIT("lu");
453 EQQ -> SLIT("e"); GTT -> SLIT("g");
454 GE -> SLIT("ge"); GU -> SLIT("gu");
455 LTT -> SLIT("l"); LE -> SLIT("le");
456 LEU -> SLIT("leu"); NE -> SLIT("ne");
457 NEG -> SLIT("neg"); POS -> SLIT("pos");
458 VC -> SLIT("vc"); VS -> SLIT("vs")
460 #if powerpc_TARGET_ARCH
462 EQQ -> SLIT("eq"); NE -> SLIT("ne");
463 LTT -> SLIT("lt"); GE -> SLIT("ge");
464 GTT -> SLIT("gt"); LE -> SLIT("le");
465 LU -> SLIT("lt"); GEU -> SLIT("ge");
466 GU -> SLIT("gt"); LEU -> SLIT("le");
471 -- -----------------------------------------------------------------------------
472 -- pprImm: print an 'Imm'
476 pprImm (ImmInt i) = int i
477 pprImm (ImmInteger i) = integer i
478 pprImm (ImmCLbl l) = pprCLabel_asm l
479 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
480 pprImm (ImmLit s) = s
482 pprImm (ImmFloat _) = panic "pprImm:ImmFloat"
483 pprImm (ImmDouble _) = panic "pprImm:ImmDouble"
485 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
486 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
487 <> lparen <> pprImm b <> rparen
489 #if sparc_TARGET_ARCH
491 = hcat [ pp_lo, pprImm i, rparen ]
496 = hcat [ pp_hi, pprImm i, rparen ]
500 #if powerpc_TARGET_ARCH
503 = hcat [ pp_lo, pprImm i, rparen ]
508 = hcat [ pp_hi, pprImm i, rparen ]
513 = hcat [ pp_ha, pprImm i, rparen ]
519 = pprImm i <> text "@l"
522 = pprImm i <> text "@h"
525 = pprImm i <> text "@ha"
530 -- -----------------------------------------------------------------------------
531 -- @pprAddr: print an 'AddrMode'
533 pprAddr :: AddrMode -> Doc
535 #if alpha_TARGET_ARCH
536 pprAddr (AddrReg r) = parens (pprReg r)
537 pprAddr (AddrImm i) = pprImm i
538 pprAddr (AddrRegImm r1 i)
539 = (<>) (pprImm i) (parens (pprReg r1))
544 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
545 pprAddr (ImmAddr imm off)
546 = let pp_imm = pprImm imm
550 else if (off < 0) then
553 pp_imm <> char '+' <> int off
555 pprAddr (AddrBaseIndex base index displacement)
557 pp_disp = ppr_disp displacement
558 pp_off p = pp_disp <> char '(' <> p <> char ')'
559 pp_reg r = pprReg wordRep r
562 (Nothing, Nothing) -> pp_disp
563 (Just b, Nothing) -> pp_off (pp_reg b)
564 (Nothing, Just (r,i)) -> pp_off (comma <> pp_reg r <> comma <> int i)
565 (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
568 ppr_disp (ImmInt 0) = empty
569 ppr_disp imm = pprImm imm
574 #if sparc_TARGET_ARCH
575 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
577 pprAddr (AddrRegReg r1 r2)
578 = hcat [ pprReg r1, char '+', pprReg r2 ]
580 pprAddr (AddrRegImm r1 (ImmInt i))
582 | not (fits13Bits i) = largeOffsetError i
583 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
585 pp_sign = if i > 0 then char '+' else empty
587 pprAddr (AddrRegImm r1 (ImmInteger i))
589 | not (fits13Bits i) = largeOffsetError i
590 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
592 pp_sign = if i > 0 then char '+' else empty
594 pprAddr (AddrRegImm r1 imm)
595 = hcat [ pprReg r1, char '+', pprImm imm ]
600 #if powerpc_TARGET_ARCH
601 pprAddr (AddrRegReg r1 r2)
602 = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
604 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
605 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
606 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
610 -- -----------------------------------------------------------------------------
611 -- pprData: print a 'CmmStatic'
613 pprSectionHeader Text
615 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
616 ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
617 ,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
618 ,IF_ARCH_x86_64(SLIT(".text\n\t.align 8") {-needs per-OS variation!-}
619 ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
621 pprSectionHeader Data
623 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
624 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
625 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
626 ,IF_ARCH_x86_64(SLIT(".data\n\t.align 8")
627 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
629 pprSectionHeader ReadOnlyData
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(SLIT(".section .rodata\n\t.align 4")
634 ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
635 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
636 SLIT(".section .rodata\n\t.align 2"))
638 pprSectionHeader RelocatableReadOnlyData
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(SLIT(".section .rodata\n\t.align 4")
643 ,IF_ARCH_x86_64(SLIT(".text\n\t.align 8")
644 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
645 SLIT(".data\n\t.align 2"))
647 -- the assembler on x86_64/Linux refuses to generate code for
649 -- where x is in the text section and y in the rodata section.
650 -- It works if y is in the text section, though. This is probably
651 -- going to cause difficulties for PIC, I imagine.
652 pprSectionHeader UninitialisedData
654 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
655 ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
656 ,IF_ARCH_i386(SLIT(".section .bss\n\t.align 4")
657 ,IF_ARCH_x86_64(SLIT(".section .bss\n\t.align 8")
658 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
659 SLIT(".section .bss\n\t.align 2"))
661 pprSectionHeader ReadOnlyData16
663 IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
664 ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
665 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 16")
666 ,IF_ARCH_x86_64(SLIT(".section .rodata.cst16\n\t.align 16")
667 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
668 SLIT(".section .rodata\n\t.align 4"))
671 pprSectionHeader (OtherSection sec)
672 = panic "PprMach.pprSectionHeader: unknown section"
674 pprData :: CmmStatic -> Doc
675 pprData (CmmAlign bytes) = pprAlign bytes
676 pprData (CmmDataLabel lbl) = pprLabel lbl
677 pprData (CmmString str) = pprASCII str
678 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
679 pprData (CmmStaticLit lit) = pprDataItem lit
681 pprGloblDecl :: CLabel -> Doc
683 | not (externallyVisibleCLabel lbl) = empty
684 | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
688 pprLabel :: CLabel -> Doc
689 pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
692 -- Assume we want to backslash-convert the string
694 = vcat (map do1 (str ++ [chr 0]))
697 do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
700 hshow n | n >= 0 && n <= 255
701 = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
702 tab = "0123456789ABCDEF"
705 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
706 IF_ARCH_i386(ptext SLIT(".align ") <> int bytes,
707 IF_ARCH_x86_64(ptext SLIT(".align ") <> int bytes,
708 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
709 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
713 log2 :: Int -> Int -- cache the common ones
718 log2 n = 1 + log2 (n `quot` 2)
721 pprDataItem :: CmmLit -> Doc
723 = vcat (ppr_item (cmmLitRep lit) lit)
727 -- These seem to be common:
728 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
729 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
730 ppr_item F32 (CmmFloat r _)
731 = let bs = floatToBytes (fromRational r)
732 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
733 ppr_item F64 (CmmFloat r _)
734 = let bs = doubleToBytes (fromRational r)
735 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
737 #if sparc_TARGET_ARCH
738 -- copy n paste of x86 version
739 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
740 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
742 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
743 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
744 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
746 #if powerpc_TARGET_ARCH
747 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
748 ppr_item I64 (CmmInt x _) =
749 [ptext SLIT("\t.long\t")
751 (fromIntegral (x `shiftR` 32) :: Word32)),
752 ptext SLIT("\t.long\t")
753 <> int (fromIntegral (fromIntegral x :: Word32))]
756 -- fall through to rest of (machine-specific) pprInstr...
758 -- -----------------------------------------------------------------------------
759 -- pprInstr: print an 'Instr'
761 pprInstr :: Instr -> Doc
763 --pprInstr (COMMENT s) = empty -- nuke 'em
765 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
766 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
767 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
768 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
769 ,IF_ARCH_powerpc( IF_OS_linux(
770 ((<>) (ptext SLIT("# ")) (ftext s)),
771 ((<>) (ptext SLIT("; ")) (ftext s)))
775 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
777 pprInstr (NEWBLOCK _)
778 = panic "PprMach.pprInstr: NEWBLOCK"
781 = panic "PprMach.pprInstr: LDATA"
783 -- -----------------------------------------------------------------------------
784 -- pprInstr for an Alpha
786 #if alpha_TARGET_ARCH
788 pprInstr (LD size reg addr)
798 pprInstr (LDA reg addr)
800 ptext SLIT("\tlda\t"),
806 pprInstr (LDAH reg addr)
808 ptext SLIT("\tldah\t"),
814 pprInstr (LDGP reg addr)
816 ptext SLIT("\tldgp\t"),
822 pprInstr (LDI size reg imm)
832 pprInstr (ST size reg addr)
844 ptext SLIT("\tclr\t"),
848 pprInstr (ABS size ri reg)
858 pprInstr (NEG size ov ri reg)
862 if ov then ptext SLIT("v\t") else char '\t',
868 pprInstr (ADD size ov reg1 ri reg2)
872 if ov then ptext SLIT("v\t") else char '\t',
880 pprInstr (SADD size scale reg1 ri reg2)
882 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
893 pprInstr (SUB size ov reg1 ri reg2)
897 if ov then ptext SLIT("v\t") else char '\t',
905 pprInstr (SSUB size scale reg1 ri reg2)
907 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
918 pprInstr (MUL size ov reg1 ri reg2)
922 if ov then ptext SLIT("v\t") else char '\t',
930 pprInstr (DIV size uns reg1 ri reg2)
934 if uns then ptext SLIT("u\t") else char '\t',
942 pprInstr (REM size uns reg1 ri reg2)
946 if uns then ptext SLIT("u\t") else char '\t',
954 pprInstr (NOT ri reg)
963 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
964 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
965 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
966 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
967 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
968 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
970 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
971 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
972 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
974 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
975 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
977 pprInstr (NOP) = ptext SLIT("\tnop")
979 pprInstr (CMP cond reg1 ri reg2)
993 ptext SLIT("\tfclr\t"),
997 pprInstr (FABS reg1 reg2)
999 ptext SLIT("\tfabs\t"),
1005 pprInstr (FNEG size reg1 reg2)
1007 ptext SLIT("\tneg"),
1015 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1016 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1017 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1018 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1020 pprInstr (CVTxy size1 size2 reg1 reg2)
1022 ptext SLIT("\tcvt"),
1024 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1031 pprInstr (FCMP size cond reg1 reg2 reg3)
1033 ptext SLIT("\tcmp"),
1044 pprInstr (FMOV reg1 reg2)
1046 ptext SLIT("\tfmov\t"),
1052 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1054 pprInstr (BI NEVER reg lab) = empty
1056 pprInstr (BI cond reg lab)
1066 pprInstr (BF cond reg lab)
1077 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1079 pprInstr (JMP reg addr hint)
1081 ptext SLIT("\tjmp\t"),
1089 pprInstr (BSR imm n)
1090 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1092 pprInstr (JSR reg addr n)
1094 ptext SLIT("\tjsr\t"),
1100 pprInstr (FUNBEGIN clab)
1102 if (externallyVisibleCLabel clab) then
1103 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1106 ptext SLIT("\t.ent "),
1115 pp_lab = pprCLabel_asm clab
1117 -- NEVER use commas within those string literals, cpp will ruin your day
1118 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1119 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1120 ptext SLIT("4240"), char ',',
1121 ptext SLIT("$26"), char ',',
1122 ptext SLIT("0\n\t.prologue 1") ]
1124 pprInstr (FUNEND clab)
1125 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1128 Continue with Alpha-only printing bits and bobs:
1132 pprRI (RIReg r) = pprReg r
1133 pprRI (RIImm r) = pprImm r
1135 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1136 pprRegRIReg name reg1 ri reg2
1148 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1149 pprSizeRegRegReg name size reg1 reg2 reg3
1162 #endif /* alpha_TARGET_ARCH */
1165 -- -----------------------------------------------------------------------------
1166 -- pprInstr for an x86
1168 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1170 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1173 #if 0 /* #ifdef DEBUG */
1174 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1179 pprInstr (MOV size src dst)
1180 = pprSizeOpOp SLIT("mov") size src dst
1182 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1183 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1184 -- movl. But we represent it as a MOVZxL instruction, because
1185 -- the reg alloc would tend to throw away a plain reg-to-reg
1186 -- move, and we still want it to do that.
1188 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes wordRep src dst
1189 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1191 -- here we do some patching, since the physical registers are only set late
1192 -- in the code generation.
1193 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1195 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1196 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1198 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1199 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
1201 = pprInstr (ADD size (OpImm displ) dst)
1202 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1204 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1205 = pprSizeOp SLIT("dec") size dst
1206 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1207 = pprSizeOp SLIT("inc") size dst
1208 pprInstr (ADD size src dst)
1209 = pprSizeOpOp SLIT("add") size src dst
1210 pprInstr (ADC size src dst)
1211 = pprSizeOpOp SLIT("adc") size src dst
1212 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1213 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1215 {- A hack. The Intel documentation says that "The two and three
1216 operand forms [of IMUL] may also be used with unsigned operands
1217 because the lower half of the product is the same regardless if
1218 (sic) the operands are signed or unsigned. The CF and OF flags,
1219 however, cannot be used to determine if the upper half of the
1220 result is non-zero." So there.
1222 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1223 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1225 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1226 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1227 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1229 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1230 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1232 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1233 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1234 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1236 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1238 pprInstr (CMP size src dst)
1239 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1240 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1242 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1243 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1244 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1246 -- both unused (SDM):
1247 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1248 -- pprInstr POPA = ptext SLIT("\tpopal")
1250 pprInstr NOP = ptext SLIT("\tnop")
1251 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1252 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1254 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1256 pprInstr (JXX cond (BlockId id))
1257 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1258 where lab = mkAsmTempLabel id
1260 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1261 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1262 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1263 pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1264 pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1266 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1267 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1268 pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
1270 #if x86_64_TARGET_ARCH
1271 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1273 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1275 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1276 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1277 pprInstr (CVTSS2SI from to) = pprOpReg SLIT("cvtss2si") from to
1278 pprInstr (CVTSD2SI from to) = pprOpReg SLIT("cvtsd2si") from to
1279 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ss") from to
1280 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sd") from to
1283 pprInstr (FETCHGOT reg)
1284 = vcat [ ptext SLIT("\tcall 1f"),
1285 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1286 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1292 -- -----------------------------------------------------------------------------
1293 -- i386 floating-point
1295 #if i386_TARGET_ARCH
1296 -- Simulating a flat register set on the x86 FP stack is tricky.
1297 -- you have to free %st(7) before pushing anything on the FP reg stack
1298 -- so as to preclude the possibility of a FP stack overflow exception.
1299 pprInstr g@(GMOV src dst)
1303 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1305 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1306 pprInstr g@(GLD sz addr dst)
1307 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1308 pprAddr addr, gsemi, gpop dst 1])
1310 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1311 pprInstr g@(GST sz src addr)
1312 = pprG g (hcat [gtab, gpush src 0, gsemi,
1313 text "fstp", pprSize sz, gsp, pprAddr addr])
1315 pprInstr g@(GLDZ dst)
1316 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1317 pprInstr g@(GLD1 dst)
1318 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1320 pprInstr g@(GFTOI src dst)
1321 = pprInstr (GDTOI src dst)
1322 pprInstr g@(GDTOI src dst)
1323 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1324 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1327 pprInstr g@(GITOF src dst)
1328 = pprInstr (GITOD src dst)
1329 pprInstr g@(GITOD src dst)
1330 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1331 text " ; ffree %st(7); fildl (%esp) ; ",
1332 gpop dst 1, text " ; addl $4,%esp"])
1334 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1335 this far into the jungle AND you give a Rat's Ass (tm) what's going
1336 on, here's the deal. Generate code to do a floating point comparison
1337 of src1 and src2, of kind cond, and set the Zero flag if true.
1339 The complications are to do with handling NaNs correctly. We want the
1340 property that if either argument is NaN, then the result of the
1341 comparison is False ... except if we're comparing for inequality,
1342 in which case the answer is True.
1344 Here's how the general (non-inequality) case works. As an
1345 example, consider generating the an equality test:
1347 pushl %eax -- we need to mess with this
1348 <get src1 to top of FPU stack>
1349 fcomp <src2 location in FPU stack> and pop pushed src1
1350 -- Result of comparison is in FPU Status Register bits
1352 fstsw %ax -- Move FPU Status Reg to %ax
1353 sahf -- move C3 C2 C0 from %ax to integer flag reg
1354 -- now the serious magic begins
1355 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1356 sete %al -- %al = if arg1 == arg2 then 1 else 0
1357 andb %ah,%al -- %al &= %ah
1358 -- so %al == 1 iff (comparable && same); else it holds 0
1359 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1360 else %al == 0xFF, ZeroFlag=0
1361 -- the zero flag is now set as we desire.
1364 The special case of inequality differs thusly:
1366 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1367 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1368 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1369 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1370 else (%al == 0xFF, ZF=0)
1372 pprInstr g@(GCMP cond src1 src2)
1373 | case cond of { NE -> True; other -> False }
1375 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1376 hcat [gtab, text "fcomp ", greg src2 1,
1377 text "; fstsw %ax ; sahf ; setpe %ah"],
1378 hcat [gtab, text "setne %al ; ",
1379 text "orb %ah,%al ; decb %al ; popl %eax"]
1383 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1384 hcat [gtab, text "fcomp ", greg src2 1,
1385 text "; fstsw %ax ; sahf ; setpo %ah"],
1386 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1387 text "andb %ah,%al ; decb %al ; popl %eax"]
1390 {- On the 486, the flags set by FP compare are the unsigned ones!
1391 (This looks like a HACK to me. WDP 96/03)
1393 fix_FP_cond :: Cond -> Cond
1394 fix_FP_cond GE = GEU
1395 fix_FP_cond GTT = GU
1396 fix_FP_cond LTT = LU
1397 fix_FP_cond LE = LEU
1398 fix_FP_cond EQQ = EQQ
1400 -- there should be no others
1403 pprInstr g@(GABS sz src dst)
1404 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1405 pprInstr g@(GNEG sz src dst)
1406 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1408 pprInstr g@(GSQRT sz src dst)
1409 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1410 hcat [gtab, gcoerceto sz, gpop dst 1])
1411 pprInstr g@(GSIN sz src dst)
1412 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1413 hcat [gtab, gcoerceto sz, gpop dst 1])
1414 pprInstr g@(GCOS sz src dst)
1415 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1416 hcat [gtab, gcoerceto sz, gpop dst 1])
1417 pprInstr g@(GTAN sz src dst)
1418 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1419 gpush src 0, text " ; fptan ; ",
1420 text " fstp %st(0)"] $$
1421 hcat [gtab, gcoerceto sz, gpop dst 1])
1423 -- In the translations for GADD, GMUL, GSUB and GDIV,
1424 -- the first two cases are mere optimisations. The otherwise clause
1425 -- generates correct code under all circumstances.
1427 pprInstr g@(GADD sz src1 src2 dst)
1429 = pprG g (text "\t#GADD-xxxcase1" $$
1430 hcat [gtab, gpush src2 0,
1431 text " ; faddp %st(0),", greg src1 1])
1433 = pprG g (text "\t#GADD-xxxcase2" $$
1434 hcat [gtab, gpush src1 0,
1435 text " ; faddp %st(0),", greg src2 1])
1437 = pprG g (hcat [gtab, gpush src1 0,
1438 text " ; fadd ", greg src2 1, text ",%st(0)",
1442 pprInstr g@(GMUL sz src1 src2 dst)
1444 = pprG g (text "\t#GMUL-xxxcase1" $$
1445 hcat [gtab, gpush src2 0,
1446 text " ; fmulp %st(0),", greg src1 1])
1448 = pprG g (text "\t#GMUL-xxxcase2" $$
1449 hcat [gtab, gpush src1 0,
1450 text " ; fmulp %st(0),", greg src2 1])
1452 = pprG g (hcat [gtab, gpush src1 0,
1453 text " ; fmul ", greg src2 1, text ",%st(0)",
1457 pprInstr g@(GSUB sz src1 src2 dst)
1459 = pprG g (text "\t#GSUB-xxxcase1" $$
1460 hcat [gtab, gpush src2 0,
1461 text " ; fsubrp %st(0),", greg src1 1])
1463 = pprG g (text "\t#GSUB-xxxcase2" $$
1464 hcat [gtab, gpush src1 0,
1465 text " ; fsubp %st(0),", greg src2 1])
1467 = pprG g (hcat [gtab, gpush src1 0,
1468 text " ; fsub ", greg src2 1, text ",%st(0)",
1472 pprInstr g@(GDIV sz src1 src2 dst)
1474 = pprG g (text "\t#GDIV-xxxcase1" $$
1475 hcat [gtab, gpush src2 0,
1476 text " ; fdivrp %st(0),", greg src1 1])
1478 = pprG g (text "\t#GDIV-xxxcase2" $$
1479 hcat [gtab, gpush src1 0,
1480 text " ; fdivp %st(0),", greg src2 1])
1482 = pprG g (hcat [gtab, gpush src1 0,
1483 text " ; fdiv ", greg src2 1, text ",%st(0)",
1488 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1489 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1492 --------------------------
1494 -- coerce %st(0) to the specified size
1495 gcoerceto F64 = empty
1496 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1499 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1501 = hcat [text "fstp ", greg reg offset]
1503 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1508 gregno (RealReg i) = i
1509 gregno other = --pprPanic "gregno" (ppr other)
1510 999 -- bogus; only needed for debug printing
1512 pprG :: Instr -> Doc -> Doc
1514 = (char '#' <> pprGInstr fake) $$ actual
1516 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1517 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1518 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1520 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1521 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1523 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1524 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1526 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1527 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1529 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1530 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1531 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1532 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1533 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1534 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1535 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1537 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1538 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1539 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1540 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1543 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1545 -- Continue with I386-only printing bits and bobs:
1547 pprDollImm :: Imm -> Doc
1549 pprDollImm i = ptext SLIT("$") <> pprImm i
1551 pprOperand :: MachRep -> Operand -> Doc
1552 pprOperand s (OpReg r) = pprReg s r
1553 pprOperand s (OpImm i) = pprDollImm i
1554 pprOperand s (OpAddr ea) = pprAddr ea
1556 pprMnemonic_ :: LitString -> Doc
1558 char '\t' <> ptext name <> space
1560 pprMnemonic :: LitString -> MachRep -> Doc
1561 pprMnemonic name size =
1562 char '\t' <> ptext name <> pprSize size <> space
1564 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1565 pprSizeImmOp name size imm op1
1567 pprMnemonic name size,
1574 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1575 pprSizeOp name size op1
1577 pprMnemonic name size,
1581 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1582 pprSizeOpOp name size op1 op2
1584 pprMnemonic name size,
1585 pprOperand size op1,
1590 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1591 pprOpOp name size op1 op2
1594 pprOperand size op1,
1599 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1600 pprSizeReg name size reg1
1602 pprMnemonic name size,
1606 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1607 pprSizeRegReg name size reg1 reg2
1609 pprMnemonic name size,
1615 pprRegReg :: LitString -> Reg -> Reg -> Doc
1616 pprRegReg name reg1 reg2
1619 pprReg wordRep reg1,
1624 pprOpReg :: LitString -> Operand -> Reg -> Doc
1625 pprOpReg name op1 reg2
1628 pprOperand wordRep op1,
1633 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1634 pprCondRegReg name size cond reg1 reg2
1645 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1646 pprSizeSizeRegReg name size1 size2 reg1 reg2
1659 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1660 pprSizeRegRegReg name size reg1 reg2 reg3
1662 pprMnemonic name size,
1670 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1671 pprSizeAddrReg name size op dst
1673 pprMnemonic name size,
1679 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1680 pprSizeRegAddr name size src op
1682 pprMnemonic name size,
1688 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1689 pprShift name size src dest
1691 pprMnemonic name size,
1692 pprOperand I8 src, -- src is 8-bit sized
1694 pprOperand size dest
1697 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1698 pprSizeOpOpCoerce name size1 size2 op1 op2
1699 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1700 pprOperand size1 op1,
1702 pprOperand size2 op2
1705 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1706 pprCondInstr name cond arg
1707 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1709 #endif /* i386_TARGET_ARCH */
1712 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1714 #if sparc_TARGET_ARCH
1716 -- a clumsy hack for now, to handle possible double alignment problems
1718 -- even clumsier, to allow for RegReg regs that show when doing indexed
1719 -- reads (bytearrays).
1722 -- Translate to the following:
1725 -- ld [g1+4],%f(n+1)
1726 -- sub g1,g2,g1 -- to restore g1
1727 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1729 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1730 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1731 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1732 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1737 -- ld [addr+4],%f(n+1)
1738 pprInstr (LD DF addr reg) | isJust off_addr
1740 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1741 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1744 off_addr = addrOffset addr 4
1745 addr2 = case off_addr of Just x -> x
1748 pprInstr (LD size addr reg)
1759 -- The same clumsy hack as above
1761 -- Translate to the following:
1764 -- st %f(n+1),[g1+4]
1765 -- sub g1,g2,g1 -- to restore g1
1766 pprInstr (ST DF reg (AddrRegReg g1 g2))
1768 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1769 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1771 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1772 pprReg g1, ptext SLIT("+4]")],
1773 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1778 -- st %f(n+1),[addr+4]
1779 pprInstr (ST DF reg addr) | isJust off_addr
1781 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1782 pprAddr addr, rbrack],
1783 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1784 pprAddr addr2, rbrack]
1787 off_addr = addrOffset addr 4
1788 addr2 = case off_addr of Just x -> x
1790 -- no distinction is made between signed and unsigned bytes on stores for the
1791 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1792 -- so we call a special-purpose pprSize for ST..
1794 pprInstr (ST size reg addr)
1805 pprInstr (ADD x cc reg1 ri reg2)
1806 | not x && not cc && riZero ri
1807 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1809 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1811 pprInstr (SUB x cc reg1 ri reg2)
1812 | not x && cc && reg2 == g0
1813 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1814 | not x && not cc && riZero ri
1815 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1817 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1819 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1820 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1822 pprInstr (OR b reg1 ri reg2)
1823 | not b && reg1 == g0
1824 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1826 RIReg rrr | rrr == reg2 -> empty
1829 = pprRegRIReg SLIT("or") b reg1 ri reg2
1831 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1833 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1834 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1836 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1837 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1838 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1840 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1841 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1842 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1844 pprInstr (SETHI imm reg)
1846 ptext SLIT("\tsethi\t"),
1852 pprInstr NOP = ptext SLIT("\tnop")
1854 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1855 pprInstr (FABS DF reg1 reg2)
1856 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1857 (if (reg1 == reg2) then empty
1858 else (<>) (char '\n')
1859 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1861 pprInstr (FADD size reg1 reg2 reg3)
1862 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1863 pprInstr (FCMP e size reg1 reg2)
1864 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1865 pprInstr (FDIV size reg1 reg2 reg3)
1866 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1868 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1869 pprInstr (FMOV DF reg1 reg2)
1870 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1871 (if (reg1 == reg2) then empty
1872 else (<>) (char '\n')
1873 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1875 pprInstr (FMUL size reg1 reg2 reg3)
1876 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1878 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1879 pprInstr (FNEG DF reg1 reg2)
1880 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1881 (if (reg1 == reg2) then empty
1882 else (<>) (char '\n')
1883 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1885 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1886 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1887 pprInstr (FxTOy size1 size2 reg1 reg2)
1900 pprReg reg1, comma, pprReg reg2
1904 pprInstr (BI cond b lab)
1906 ptext SLIT("\tb"), pprCond cond,
1907 if b then pp_comma_a else empty,
1912 pprInstr (BF cond b lab)
1914 ptext SLIT("\tfb"), pprCond cond,
1915 if b then pp_comma_a else empty,
1920 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1922 pprInstr (CALL (Left imm) n _)
1923 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1924 pprInstr (CALL (Right reg) n _)
1925 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1928 Continue with SPARC-only printing bits and bobs:
1931 pprRI (RIReg r) = pprReg r
1932 pprRI (RIImm r) = pprImm r
1934 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1935 pprSizeRegReg name size reg1 reg2
1940 F -> ptext SLIT("s\t")
1941 DF -> ptext SLIT("d\t")),
1947 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1948 pprSizeRegRegReg name size reg1 reg2 reg3
1953 F -> ptext SLIT("s\t")
1954 DF -> ptext SLIT("d\t")),
1962 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
1963 pprRegRIReg name b reg1 ri reg2
1967 if b then ptext SLIT("cc\t") else char '\t',
1975 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
1976 pprRIReg name b ri reg1
1980 if b then ptext SLIT("cc\t") else char '\t',
1986 pp_ld_lbracket = ptext SLIT("\tld\t[")
1987 pp_rbracket_comma = text "],"
1988 pp_comma_lbracket = text ",["
1989 pp_comma_a = text ",a"
1991 #endif /* sparc_TARGET_ARCH */
1994 -- -----------------------------------------------------------------------------
1995 -- pprInstr for PowerPC
1997 #if powerpc_TARGET_ARCH
1998 pprInstr (LD sz reg addr) = hcat [
2007 case addr of AddrRegImm _ _ -> empty
2008 AddrRegReg _ _ -> char 'x',
2014 pprInstr (LA sz reg addr) = hcat [
2023 case addr of AddrRegImm _ _ -> empty
2024 AddrRegReg _ _ -> char 'x',
2030 pprInstr (ST sz reg addr) = hcat [
2034 case addr of AddrRegImm _ _ -> empty
2035 AddrRegReg _ _ -> char 'x',
2041 pprInstr (STU sz reg addr) = hcat [
2046 case addr of AddrRegImm _ _ -> empty
2047 AddrRegReg _ _ -> char 'x',
2052 pprInstr (LIS reg imm) = hcat [
2060 pprInstr (LI reg imm) = hcat [
2068 pprInstr (MR reg1 reg2)
2069 | reg1 == reg2 = empty
2070 | otherwise = hcat [
2072 case regClass reg1 of
2073 RcInteger -> ptext SLIT("mr")
2074 _ -> ptext SLIT("fmr"),
2080 pprInstr (CMP sz reg ri) = hcat [
2096 pprInstr (CMPL sz reg ri) = hcat [
2112 pprInstr (BCC cond (BlockId id)) = hcat [
2119 where lbl = mkAsmTempLabel id
2121 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2128 pprInstr (MTCTR reg) = hcat [
2130 ptext SLIT("mtctr"),
2134 pprInstr (BCTR _) = hcat [
2138 pprInstr (BL lbl _) = hcat [
2139 ptext SLIT("\tbl\t"),
2142 pprInstr (BCTRL _) = hcat [
2146 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2147 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2149 ptext SLIT("addis"),
2158 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2159 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2160 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2161 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2162 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2163 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2164 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2166 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2167 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2168 pprReg reg2, ptext SLIT(", "),
2170 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2171 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2172 pprReg reg1, ptext SLIT(", "),
2173 ptext SLIT("2, 31, 31") ]
2176 -- for some reason, "andi" doesn't exist.
2177 -- we'll use "andi." instead.
2178 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2180 ptext SLIT("andi."),
2188 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2190 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2191 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2193 pprInstr (XORIS reg1 reg2 imm) = hcat [
2195 ptext SLIT("xoris"),
2204 pprInstr (EXTS sz reg1 reg2) = hcat [
2214 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2215 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2217 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2218 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2219 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2220 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2221 ptext SLIT("\trlwinm\t"),
2233 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2234 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2235 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2236 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2237 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2239 pprInstr (FCMP reg1 reg2) = hcat [
2241 ptext SLIT("fcmpu\tcr0, "),
2242 -- Note: we're using fcmpu, not fcmpo
2243 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2244 -- We don't handle invalid fp ops, so we don't care
2250 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2251 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2253 pprInstr (CRNOR dst src1 src2) = hcat [
2254 ptext SLIT("\tcrnor\t"),
2262 pprInstr (MFCR reg) = hcat [
2269 pprInstr (MFLR reg) = hcat [
2276 pprInstr (FETCHPC reg) = vcat [
2277 ptext SLIT("\tbcl\t20,31,1f"),
2278 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2281 pprInstr _ = panic "pprInstr (ppc)"
2283 pprLogic op reg1 reg2 ri = hcat [
2288 RIImm _ -> char 'i',
2297 pprUnary op reg1 reg2 = hcat [
2306 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2319 pprRI (RIReg r) = pprReg r
2320 pprRI (RIImm r) = pprImm r
2322 pprFSize F64 = empty
2323 pprFSize F32 = char 's'
2325 -- limit immediate argument for shift instruction to range 0..32
2326 -- (yes, the maximum is really 32, not 31)
2327 limitShiftRI :: RI -> RI
2328 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2331 #endif /* powerpc_TARGET_ARCH */
2334 -- -----------------------------------------------------------------------------
2335 -- Converting floating-point literals to integrals for printing
2337 #if __GLASGOW_HASKELL__ >= 504
2338 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
2339 newFloatArray = newArray_
2341 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
2342 newDoubleArray = newArray_
2344 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2345 castFloatToCharArray = castSTUArray
2347 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2348 castDoubleToCharArray = castSTUArray
2350 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
2351 writeFloatArray = writeArray
2353 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
2354 writeDoubleArray = writeArray
2356 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
2357 readCharArray arr i = do
2358 w <- readArray arr i
2359 return $! (chr (fromIntegral w))
2363 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2364 castFloatToCharArray = return
2366 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2369 castDoubleToCharArray = return
2373 -- floatToBytes and doubleToBytes convert to the host's byte
2374 -- order. Providing that we're not cross-compiling for a
2375 -- target with the opposite endianness, this should work ok
2378 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2379 -- could they be merged?
2381 floatToBytes :: Float -> [Int]
2384 arr <- newFloatArray ((0::Int),3)
2385 writeFloatArray arr 0 f
2386 arr <- castFloatToCharArray arr
2387 i0 <- readCharArray arr 0
2388 i1 <- readCharArray arr 1
2389 i2 <- readCharArray arr 2
2390 i3 <- readCharArray arr 3
2391 return (map ord [i0,i1,i2,i3])
2394 doubleToBytes :: Double -> [Int]
2397 arr <- newDoubleArray ((0::Int),7)
2398 writeDoubleArray arr 0 d
2399 arr <- castDoubleToCharArray arr
2400 i0 <- readCharArray arr 0
2401 i1 <- readCharArray arr 1
2402 i2 <- readCharArray arr 2
2403 i3 <- readCharArray arr 3
2404 i4 <- readCharArray arr 4
2405 i5 <- readCharArray arr 5
2406 i6 <- readCharArray arr 6
2407 i7 <- readCharArray arr 7
2408 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])