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"); 29 -> SLIT("%xmm13");
267 30 -> SLIT("%xmm14"); 31 -> SLIT("%xmm15");
268 _ -> SLIT("very naughty x86_64 register")
272 #if sparc_TARGET_ARCH
273 ppr_reg_no :: Int -> Doc
276 0 -> SLIT("%g0"); 1 -> SLIT("%g1");
277 2 -> SLIT("%g2"); 3 -> SLIT("%g3");
278 4 -> SLIT("%g4"); 5 -> SLIT("%g5");
279 6 -> SLIT("%g6"); 7 -> SLIT("%g7");
280 8 -> SLIT("%o0"); 9 -> SLIT("%o1");
281 10 -> SLIT("%o2"); 11 -> SLIT("%o3");
282 12 -> SLIT("%o4"); 13 -> SLIT("%o5");
283 14 -> SLIT("%o6"); 15 -> SLIT("%o7");
284 16 -> SLIT("%l0"); 17 -> SLIT("%l1");
285 18 -> SLIT("%l2"); 19 -> SLIT("%l3");
286 20 -> SLIT("%l4"); 21 -> SLIT("%l5");
287 22 -> SLIT("%l6"); 23 -> SLIT("%l7");
288 24 -> SLIT("%i0"); 25 -> SLIT("%i1");
289 26 -> SLIT("%i2"); 27 -> SLIT("%i3");
290 28 -> SLIT("%i4"); 29 -> SLIT("%i5");
291 30 -> SLIT("%i6"); 31 -> SLIT("%i7");
292 32 -> SLIT("%f0"); 33 -> SLIT("%f1");
293 34 -> SLIT("%f2"); 35 -> SLIT("%f3");
294 36 -> SLIT("%f4"); 37 -> SLIT("%f5");
295 38 -> SLIT("%f6"); 39 -> SLIT("%f7");
296 40 -> SLIT("%f8"); 41 -> SLIT("%f9");
297 42 -> SLIT("%f10"); 43 -> SLIT("%f11");
298 44 -> SLIT("%f12"); 45 -> SLIT("%f13");
299 46 -> SLIT("%f14"); 47 -> SLIT("%f15");
300 48 -> SLIT("%f16"); 49 -> SLIT("%f17");
301 50 -> SLIT("%f18"); 51 -> SLIT("%f19");
302 52 -> SLIT("%f20"); 53 -> SLIT("%f21");
303 54 -> SLIT("%f22"); 55 -> SLIT("%f23");
304 56 -> SLIT("%f24"); 57 -> SLIT("%f25");
305 58 -> SLIT("%f26"); 59 -> SLIT("%f27");
306 60 -> SLIT("%f28"); 61 -> SLIT("%f29");
307 62 -> SLIT("%f30"); 63 -> SLIT("%f31");
308 _ -> SLIT("very naughty sparc register")
311 #if powerpc_TARGET_ARCH
313 ppr_reg_no :: Int -> Doc
316 0 -> SLIT("r0"); 1 -> SLIT("r1");
317 2 -> SLIT("r2"); 3 -> SLIT("r3");
318 4 -> SLIT("r4"); 5 -> SLIT("r5");
319 6 -> SLIT("r6"); 7 -> SLIT("r7");
320 8 -> SLIT("r8"); 9 -> SLIT("r9");
321 10 -> SLIT("r10"); 11 -> SLIT("r11");
322 12 -> SLIT("r12"); 13 -> SLIT("r13");
323 14 -> SLIT("r14"); 15 -> SLIT("r15");
324 16 -> SLIT("r16"); 17 -> SLIT("r17");
325 18 -> SLIT("r18"); 19 -> SLIT("r19");
326 20 -> SLIT("r20"); 21 -> SLIT("r21");
327 22 -> SLIT("r22"); 23 -> SLIT("r23");
328 24 -> SLIT("r24"); 25 -> SLIT("r25");
329 26 -> SLIT("r26"); 27 -> SLIT("r27");
330 28 -> SLIT("r28"); 29 -> SLIT("r29");
331 30 -> SLIT("r30"); 31 -> SLIT("r31");
332 32 -> SLIT("f0"); 33 -> SLIT("f1");
333 34 -> SLIT("f2"); 35 -> SLIT("f3");
334 36 -> SLIT("f4"); 37 -> SLIT("f5");
335 38 -> SLIT("f6"); 39 -> SLIT("f7");
336 40 -> SLIT("f8"); 41 -> SLIT("f9");
337 42 -> SLIT("f10"); 43 -> SLIT("f11");
338 44 -> SLIT("f12"); 45 -> SLIT("f13");
339 46 -> SLIT("f14"); 47 -> SLIT("f15");
340 48 -> SLIT("f16"); 49 -> SLIT("f17");
341 50 -> SLIT("f18"); 51 -> SLIT("f19");
342 52 -> SLIT("f20"); 53 -> SLIT("f21");
343 54 -> SLIT("f22"); 55 -> SLIT("f23");
344 56 -> SLIT("f24"); 57 -> SLIT("f25");
345 58 -> SLIT("f26"); 59 -> SLIT("f27");
346 60 -> SLIT("f28"); 61 -> SLIT("f29");
347 62 -> SLIT("f30"); 63 -> SLIT("f31");
348 _ -> SLIT("very naughty powerpc register")
351 ppr_reg_no :: Int -> Doc
352 ppr_reg_no i | i <= 31 = int i -- GPRs
353 | i <= 63 = int (i-32) -- FPRs
354 | otherwise = ptext SLIT("very naughty powerpc register")
359 -- -----------------------------------------------------------------------------
360 -- pprSize: print a 'Size'
362 #if powerpc_TARGET_ARCH || i386_TARGET_ARCH || x86_64_TARGET_ARCH
363 pprSize :: MachRep -> Doc
365 pprSize :: Size -> Doc
368 pprSize x = ptext (case x of
369 #if alpha_TARGET_ARCH
372 -- W -> SLIT("w") UNUSED
373 -- Wu -> SLIT("wu") UNUSED
376 -- FF -> SLIT("f") UNUSED
377 -- DF -> SLIT("d") UNUSED
378 -- GF -> SLIT("g") UNUSED
379 -- SF -> SLIT("s") UNUSED
382 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
393 #if x86_64_TARGET_ARCH
394 F32 -> SLIT("ss") -- "scalar single-precision float" (SSE2)
395 F64 -> SLIT("sd") -- "scalar double-precision float" (SSE2)
397 #if sparc_TARGET_ARCH
406 pprStSize :: Size -> Doc
407 pprStSize x = ptext (case x of
416 #if powerpc_TARGET_ARCH
425 -- -----------------------------------------------------------------------------
426 -- pprCond: print a 'Cond'
428 pprCond :: Cond -> Doc
430 pprCond c = ptext (case c of {
431 #if alpha_TARGET_ARCH
441 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
442 GEU -> SLIT("ae"); LU -> SLIT("b");
443 EQQ -> SLIT("e"); GTT -> SLIT("g");
444 GE -> SLIT("ge"); GU -> SLIT("a");
445 LTT -> SLIT("l"); LE -> SLIT("le");
446 LEU -> SLIT("be"); NE -> SLIT("ne");
447 NEG -> SLIT("s"); POS -> SLIT("ns");
448 CARRY -> SLIT("c"); OFLO -> SLIT("o");
449 PARITY -> SLIT("p"); NOTPARITY -> SLIT("np");
450 ALWAYS -> SLIT("mp") -- hack
452 #if sparc_TARGET_ARCH
453 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
454 GEU -> SLIT("geu"); LU -> SLIT("lu");
455 EQQ -> SLIT("e"); GTT -> SLIT("g");
456 GE -> SLIT("ge"); GU -> SLIT("gu");
457 LTT -> SLIT("l"); LE -> SLIT("le");
458 LEU -> SLIT("leu"); NE -> SLIT("ne");
459 NEG -> SLIT("neg"); POS -> SLIT("pos");
460 VC -> SLIT("vc"); VS -> SLIT("vs")
462 #if powerpc_TARGET_ARCH
464 EQQ -> SLIT("eq"); NE -> SLIT("ne");
465 LTT -> SLIT("lt"); GE -> SLIT("ge");
466 GTT -> SLIT("gt"); LE -> SLIT("le");
467 LU -> SLIT("lt"); GEU -> SLIT("ge");
468 GU -> SLIT("gt"); LEU -> SLIT("le");
473 -- -----------------------------------------------------------------------------
474 -- pprImm: print an 'Imm'
478 pprImm (ImmInt i) = int i
479 pprImm (ImmInteger i) = integer i
480 pprImm (ImmCLbl l) = pprCLabel_asm l
481 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
482 pprImm (ImmLit s) = s
484 pprImm (ImmFloat _) = ptext SLIT("naughty float immediate")
485 pprImm (ImmDouble _) = ptext SLIT("naughty double immediate")
487 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
488 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
489 <> lparen <> pprImm b <> rparen
491 #if sparc_TARGET_ARCH
493 = hcat [ pp_lo, pprImm i, rparen ]
498 = hcat [ pp_hi, pprImm i, rparen ]
502 #if powerpc_TARGET_ARCH
505 = hcat [ pp_lo, pprImm i, rparen ]
510 = hcat [ pp_hi, pprImm i, rparen ]
515 = hcat [ pp_ha, pprImm i, rparen ]
521 = pprImm i <> text "@l"
524 = pprImm i <> text "@h"
527 = pprImm i <> text "@ha"
532 -- -----------------------------------------------------------------------------
533 -- @pprAddr: print an 'AddrMode'
535 pprAddr :: AddrMode -> Doc
537 #if alpha_TARGET_ARCH
538 pprAddr (AddrReg r) = parens (pprReg r)
539 pprAddr (AddrImm i) = pprImm i
540 pprAddr (AddrRegImm r1 i)
541 = (<>) (pprImm i) (parens (pprReg r1))
546 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
547 pprAddr (ImmAddr imm off)
548 = let pp_imm = pprImm imm
552 else if (off < 0) then
555 pp_imm <> char '+' <> int off
557 pprAddr (AddrBaseIndex base index displacement)
559 pp_disp = ppr_disp displacement
560 pp_off p = pp_disp <> char '(' <> p <> char ')'
561 pp_reg r = pprReg wordRep r
564 (EABaseNone, EAIndexNone) -> pp_disp
565 (EABaseReg b, EAIndexNone) -> pp_off (pp_reg b)
566 (EABaseRip, EAIndexNone) -> pp_off (ptext SLIT("%rip"))
567 (EABaseNone, EAIndex r i) -> pp_off (comma <> pp_reg r <> comma <> int i)
568 (EABaseReg b, EAIndex r i) -> pp_off (pp_reg b <> comma <> pp_reg r
571 ppr_disp (ImmInt 0) = empty
572 ppr_disp imm = pprImm imm
577 #if sparc_TARGET_ARCH
578 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
580 pprAddr (AddrRegReg r1 r2)
581 = hcat [ pprReg r1, char '+', pprReg r2 ]
583 pprAddr (AddrRegImm r1 (ImmInt i))
585 | not (fits13Bits i) = largeOffsetError i
586 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
588 pp_sign = if i > 0 then char '+' else empty
590 pprAddr (AddrRegImm r1 (ImmInteger i))
592 | not (fits13Bits i) = largeOffsetError i
593 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
595 pp_sign = if i > 0 then char '+' else empty
597 pprAddr (AddrRegImm r1 imm)
598 = hcat [ pprReg r1, char '+', pprImm imm ]
603 #if powerpc_TARGET_ARCH
604 pprAddr (AddrRegReg r1 r2)
605 = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
607 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
608 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
609 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
613 -- -----------------------------------------------------------------------------
614 -- pprData: print a 'CmmStatic'
616 pprSectionHeader Text
618 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
619 ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
620 ,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
621 ,IF_ARCH_x86_64(SLIT(".text\n\t.align 8") {-needs per-OS variation!-}
622 ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
624 pprSectionHeader Data
626 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
627 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
628 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
629 ,IF_ARCH_x86_64(SLIT(".data\n\t.align 8")
630 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
632 pprSectionHeader ReadOnlyData
634 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
635 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
636 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
637 ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
638 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
639 SLIT(".section .rodata\n\t.align 2"))
641 pprSectionHeader RelocatableReadOnlyData
643 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
644 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
645 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
646 ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
647 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
648 SLIT(".data\n\t.align 2"))
650 pprSectionHeader UninitialisedData
652 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
653 ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
654 ,IF_ARCH_i386(SLIT(".section .bss\n\t.align 4")
655 ,IF_ARCH_x86_64(SLIT(".section .bss\n\t.align 8")
656 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
657 SLIT(".section .bss\n\t.align 2"))
659 pprSectionHeader ReadOnlyData16
661 IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
662 ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
663 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 16")
664 ,IF_ARCH_x86_64(SLIT(".section .rodata.cst16\n\t.align 16")
665 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
666 SLIT(".section .rodata\n\t.align 4"))
669 pprSectionHeader (OtherSection sec)
670 = panic "PprMach.pprSectionHeader: unknown section"
672 pprData :: CmmStatic -> Doc
673 pprData (CmmAlign bytes) = pprAlign bytes
674 pprData (CmmDataLabel lbl) = pprLabel lbl
675 pprData (CmmString str) = pprASCII str
676 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
677 pprData (CmmStaticLit lit) = pprDataItem lit
679 pprGloblDecl :: CLabel -> Doc
681 | not (externallyVisibleCLabel lbl) = empty
682 | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
686 pprLabel :: CLabel -> Doc
687 pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
690 -- Assume we want to backslash-convert the string
692 = vcat (map do1 (str ++ [chr 0]))
695 do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
698 hshow n | n >= 0 && n <= 255
699 = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
700 tab = "0123456789ABCDEF"
703 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
704 IF_ARCH_i386(ptext SLIT(".align ") <> int bytes,
705 IF_ARCH_x86_64(ptext SLIT(".align ") <> int bytes,
706 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
707 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
711 log2 :: Int -> Int -- cache the common ones
716 log2 n = 1 + log2 (n `quot` 2)
719 pprDataItem :: CmmLit -> Doc
721 = vcat (ppr_item (cmmLitRep lit) lit)
725 -- These seem to be common:
726 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
727 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
728 ppr_item F32 (CmmFloat r _)
729 = let bs = floatToBytes (fromRational r)
730 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
731 ppr_item F64 (CmmFloat r _)
732 = let bs = doubleToBytes (fromRational r)
733 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
735 #if sparc_TARGET_ARCH
736 -- copy n paste of x86 version
737 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
738 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
740 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
741 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 x86_64_TARGET_ARCH
747 -- x86_64: binutils can't handle the R_X86_64_PC64 relocation
748 -- type, which means we can't do pc-relative 64-bit addresses.
749 -- Fortunately we're assuming the small memory model, in which
750 -- all such offsets will fit into 32 bits, so we have to stick
751 -- to 32-bit offset fields and modify the RTS appropriately
752 -- (see InfoTables.h).
755 | isRelativeReloc x =
756 [ptext SLIT("\t.long\t") <> pprImm imm,
757 ptext SLIT("\t.long\t0")]
759 [ptext SLIT("\t.quad\t") <> pprImm imm]
761 isRelativeReloc (CmmLabelOff _ _) = True
762 isRelativeReloc (CmmLabelDiffOff _ _ _) = True
763 isRelativeReloc _ = False
765 #if powerpc_TARGET_ARCH
766 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
767 ppr_item I64 (CmmInt x _) =
768 [ptext SLIT("\t.long\t")
770 (fromIntegral (x `shiftR` 32) :: Word32)),
771 ptext SLIT("\t.long\t")
772 <> int (fromIntegral (fromIntegral x :: Word32))]
775 -- fall through to rest of (machine-specific) pprInstr...
777 -- -----------------------------------------------------------------------------
778 -- pprInstr: print an 'Instr'
780 pprInstr :: Instr -> Doc
782 --pprInstr (COMMENT s) = empty -- nuke 'em
784 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
785 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
786 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
787 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
788 ,IF_ARCH_powerpc( IF_OS_linux(
789 ((<>) (ptext SLIT("# ")) (ftext s)),
790 ((<>) (ptext SLIT("; ")) (ftext s)))
794 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
796 pprInstr (NEWBLOCK _)
797 = panic "PprMach.pprInstr: NEWBLOCK"
800 = panic "PprMach.pprInstr: LDATA"
802 -- -----------------------------------------------------------------------------
803 -- pprInstr for an Alpha
805 #if alpha_TARGET_ARCH
807 pprInstr (LD size reg addr)
817 pprInstr (LDA reg addr)
819 ptext SLIT("\tlda\t"),
825 pprInstr (LDAH reg addr)
827 ptext SLIT("\tldah\t"),
833 pprInstr (LDGP reg addr)
835 ptext SLIT("\tldgp\t"),
841 pprInstr (LDI size reg imm)
851 pprInstr (ST size reg addr)
863 ptext SLIT("\tclr\t"),
867 pprInstr (ABS size ri reg)
877 pprInstr (NEG size ov ri reg)
881 if ov then ptext SLIT("v\t") else char '\t',
887 pprInstr (ADD size ov reg1 ri reg2)
891 if ov then ptext SLIT("v\t") else char '\t',
899 pprInstr (SADD size scale reg1 ri reg2)
901 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
912 pprInstr (SUB size ov reg1 ri reg2)
916 if ov then ptext SLIT("v\t") else char '\t',
924 pprInstr (SSUB size scale reg1 ri reg2)
926 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
937 pprInstr (MUL size ov reg1 ri reg2)
941 if ov then ptext SLIT("v\t") else char '\t',
949 pprInstr (DIV size uns reg1 ri reg2)
953 if uns then ptext SLIT("u\t") else char '\t',
961 pprInstr (REM size uns reg1 ri reg2)
965 if uns then ptext SLIT("u\t") else char '\t',
973 pprInstr (NOT ri reg)
982 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
983 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
984 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
985 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
986 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
987 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
989 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
990 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
991 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
993 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
994 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
996 pprInstr (NOP) = ptext SLIT("\tnop")
998 pprInstr (CMP cond reg1 ri reg2)
1000 ptext SLIT("\tcmp"),
1012 ptext SLIT("\tfclr\t"),
1016 pprInstr (FABS reg1 reg2)
1018 ptext SLIT("\tfabs\t"),
1024 pprInstr (FNEG size reg1 reg2)
1026 ptext SLIT("\tneg"),
1034 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1035 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1036 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1037 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1039 pprInstr (CVTxy size1 size2 reg1 reg2)
1041 ptext SLIT("\tcvt"),
1043 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1050 pprInstr (FCMP size cond reg1 reg2 reg3)
1052 ptext SLIT("\tcmp"),
1063 pprInstr (FMOV reg1 reg2)
1065 ptext SLIT("\tfmov\t"),
1071 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1073 pprInstr (BI NEVER reg lab) = empty
1075 pprInstr (BI cond reg lab)
1085 pprInstr (BF cond reg lab)
1096 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1098 pprInstr (JMP reg addr hint)
1100 ptext SLIT("\tjmp\t"),
1108 pprInstr (BSR imm n)
1109 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1111 pprInstr (JSR reg addr n)
1113 ptext SLIT("\tjsr\t"),
1119 pprInstr (FUNBEGIN clab)
1121 if (externallyVisibleCLabel clab) then
1122 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1125 ptext SLIT("\t.ent "),
1134 pp_lab = pprCLabel_asm clab
1136 -- NEVER use commas within those string literals, cpp will ruin your day
1137 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1138 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1139 ptext SLIT("4240"), char ',',
1140 ptext SLIT("$26"), char ',',
1141 ptext SLIT("0\n\t.prologue 1") ]
1143 pprInstr (FUNEND clab)
1144 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1147 Continue with Alpha-only printing bits and bobs:
1151 pprRI (RIReg r) = pprReg r
1152 pprRI (RIImm r) = pprImm r
1154 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1155 pprRegRIReg name reg1 ri reg2
1167 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1168 pprSizeRegRegReg name size reg1 reg2 reg3
1181 #endif /* alpha_TARGET_ARCH */
1184 -- -----------------------------------------------------------------------------
1185 -- pprInstr for an x86
1187 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1189 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1192 #if 0 /* #ifdef DEBUG */
1193 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1198 pprInstr (MOV size src dst)
1199 = pprSizeOpOp SLIT("mov") size src dst
1201 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1202 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1203 -- movl. But we represent it as a MOVZxL instruction, because
1204 -- the reg alloc would tend to throw away a plain reg-to-reg
1205 -- move, and we still want it to do that.
1207 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes I32 src dst
1208 -- zero-extension only needs to extend to 32 bits: on x86_64,
1209 -- the remaining zero-extension to 64 bits is automatic, and the 32-bit
1210 -- instruction is shorter.
1212 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1214 -- here we do some patching, since the physical registers are only set late
1215 -- in the code generation.
1216 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1218 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1219 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) (EAIndex reg2 1) (ImmInt 0))) dst@(OpReg reg3))
1221 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1222 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(EABaseReg reg1) EAIndexNone displ)) dst@(OpReg reg3))
1224 = pprInstr (ADD size (OpImm displ) dst)
1225 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1227 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1228 = pprSizeOp SLIT("dec") size dst
1229 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1230 = pprSizeOp SLIT("inc") size dst
1231 pprInstr (ADD size src dst)
1232 = pprSizeOpOp SLIT("add") size src dst
1233 pprInstr (ADC size src dst)
1234 = pprSizeOpOp SLIT("adc") size src dst
1235 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1236 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1238 {- A hack. The Intel documentation says that "The two and three
1239 operand forms [of IMUL] may also be used with unsigned operands
1240 because the lower half of the product is the same regardless if
1241 (sic) the operands are signed or unsigned. The CF and OF flags,
1242 however, cannot be used to determine if the upper half of the
1243 result is non-zero." So there.
1245 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1246 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1248 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1249 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1250 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1252 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1253 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1255 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1256 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1257 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1259 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1261 pprInstr (CMP size src dst)
1262 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1263 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1265 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1266 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1267 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1269 -- both unused (SDM):
1270 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1271 -- pprInstr POPA = ptext SLIT("\tpopal")
1273 pprInstr NOP = ptext SLIT("\tnop")
1274 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1275 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1277 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1279 pprInstr (JXX cond (BlockId id))
1280 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1281 where lab = mkAsmTempLabel id
1283 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1284 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1285 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1286 pprInstr (CALL (Left imm) _) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1287 pprInstr (CALL (Right reg) _) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1289 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1290 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1291 pprInstr (IMUL2 sz op) = pprSizeOp SLIT("imul") sz op
1293 #if x86_64_TARGET_ARCH
1294 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1296 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1298 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1299 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1300 pprInstr (CVTSS2SI from to) = pprOpReg SLIT("cvtss2si") from to
1301 pprInstr (CVTSD2SI from to) = pprOpReg SLIT("cvtsd2si") from to
1302 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ss") from to
1303 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sd") from to
1306 pprInstr (FETCHGOT reg)
1307 = vcat [ ptext SLIT("\tcall 1f"),
1308 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1309 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1315 -- -----------------------------------------------------------------------------
1316 -- i386 floating-point
1318 #if i386_TARGET_ARCH
1319 -- Simulating a flat register set on the x86 FP stack is tricky.
1320 -- you have to free %st(7) before pushing anything on the FP reg stack
1321 -- so as to preclude the possibility of a FP stack overflow exception.
1322 pprInstr g@(GMOV src dst)
1326 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1328 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1329 pprInstr g@(GLD sz addr dst)
1330 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1331 pprAddr addr, gsemi, gpop dst 1])
1333 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1334 pprInstr g@(GST sz src addr)
1335 = pprG g (hcat [gtab, gpush src 0, gsemi,
1336 text "fstp", pprSize sz, gsp, pprAddr addr])
1338 pprInstr g@(GLDZ dst)
1339 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1340 pprInstr g@(GLD1 dst)
1341 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1343 pprInstr g@(GFTOI src dst)
1344 = pprInstr (GDTOI src dst)
1345 pprInstr g@(GDTOI src dst)
1346 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1347 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1350 pprInstr g@(GITOF src dst)
1351 = pprInstr (GITOD src dst)
1352 pprInstr g@(GITOD src dst)
1353 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1354 text " ; ffree %st(7); fildl (%esp) ; ",
1355 gpop dst 1, text " ; addl $4,%esp"])
1357 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1358 this far into the jungle AND you give a Rat's Ass (tm) what's going
1359 on, here's the deal. Generate code to do a floating point comparison
1360 of src1 and src2, of kind cond, and set the Zero flag if true.
1362 The complications are to do with handling NaNs correctly. We want the
1363 property that if either argument is NaN, then the result of the
1364 comparison is False ... except if we're comparing for inequality,
1365 in which case the answer is True.
1367 Here's how the general (non-inequality) case works. As an
1368 example, consider generating the an equality test:
1370 pushl %eax -- we need to mess with this
1371 <get src1 to top of FPU stack>
1372 fcomp <src2 location in FPU stack> and pop pushed src1
1373 -- Result of comparison is in FPU Status Register bits
1375 fstsw %ax -- Move FPU Status Reg to %ax
1376 sahf -- move C3 C2 C0 from %ax to integer flag reg
1377 -- now the serious magic begins
1378 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1379 sete %al -- %al = if arg1 == arg2 then 1 else 0
1380 andb %ah,%al -- %al &= %ah
1381 -- so %al == 1 iff (comparable && same); else it holds 0
1382 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1383 else %al == 0xFF, ZeroFlag=0
1384 -- the zero flag is now set as we desire.
1387 The special case of inequality differs thusly:
1389 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1390 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1391 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1392 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1393 else (%al == 0xFF, ZF=0)
1395 pprInstr g@(GCMP cond src1 src2)
1396 | case cond of { NE -> True; other -> False }
1398 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1399 hcat [gtab, text "fcomp ", greg src2 1,
1400 text "; fstsw %ax ; sahf ; setpe %ah"],
1401 hcat [gtab, text "setne %al ; ",
1402 text "orb %ah,%al ; decb %al ; popl %eax"]
1406 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1407 hcat [gtab, text "fcomp ", greg src2 1,
1408 text "; fstsw %ax ; sahf ; setpo %ah"],
1409 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1410 text "andb %ah,%al ; decb %al ; popl %eax"]
1413 {- On the 486, the flags set by FP compare are the unsigned ones!
1414 (This looks like a HACK to me. WDP 96/03)
1416 fix_FP_cond :: Cond -> Cond
1417 fix_FP_cond GE = GEU
1418 fix_FP_cond GTT = GU
1419 fix_FP_cond LTT = LU
1420 fix_FP_cond LE = LEU
1421 fix_FP_cond EQQ = EQQ
1423 -- there should be no others
1426 pprInstr g@(GABS sz src dst)
1427 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1428 pprInstr g@(GNEG sz src dst)
1429 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1431 pprInstr g@(GSQRT sz src dst)
1432 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1433 hcat [gtab, gcoerceto sz, gpop dst 1])
1434 pprInstr g@(GSIN sz src dst)
1435 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1436 hcat [gtab, gcoerceto sz, gpop dst 1])
1437 pprInstr g@(GCOS sz src dst)
1438 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1439 hcat [gtab, gcoerceto sz, gpop dst 1])
1440 pprInstr g@(GTAN sz src dst)
1441 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1442 gpush src 0, text " ; fptan ; ",
1443 text " fstp %st(0)"] $$
1444 hcat [gtab, gcoerceto sz, gpop dst 1])
1446 -- In the translations for GADD, GMUL, GSUB and GDIV,
1447 -- the first two cases are mere optimisations. The otherwise clause
1448 -- generates correct code under all circumstances.
1450 pprInstr g@(GADD sz src1 src2 dst)
1452 = pprG g (text "\t#GADD-xxxcase1" $$
1453 hcat [gtab, gpush src2 0,
1454 text " ; faddp %st(0),", greg src1 1])
1456 = pprG g (text "\t#GADD-xxxcase2" $$
1457 hcat [gtab, gpush src1 0,
1458 text " ; faddp %st(0),", greg src2 1])
1460 = pprG g (hcat [gtab, gpush src1 0,
1461 text " ; fadd ", greg src2 1, text ",%st(0)",
1465 pprInstr g@(GMUL sz src1 src2 dst)
1467 = pprG g (text "\t#GMUL-xxxcase1" $$
1468 hcat [gtab, gpush src2 0,
1469 text " ; fmulp %st(0),", greg src1 1])
1471 = pprG g (text "\t#GMUL-xxxcase2" $$
1472 hcat [gtab, gpush src1 0,
1473 text " ; fmulp %st(0),", greg src2 1])
1475 = pprG g (hcat [gtab, gpush src1 0,
1476 text " ; fmul ", greg src2 1, text ",%st(0)",
1480 pprInstr g@(GSUB sz src1 src2 dst)
1482 = pprG g (text "\t#GSUB-xxxcase1" $$
1483 hcat [gtab, gpush src2 0,
1484 text " ; fsubrp %st(0),", greg src1 1])
1486 = pprG g (text "\t#GSUB-xxxcase2" $$
1487 hcat [gtab, gpush src1 0,
1488 text " ; fsubp %st(0),", greg src2 1])
1490 = pprG g (hcat [gtab, gpush src1 0,
1491 text " ; fsub ", greg src2 1, text ",%st(0)",
1495 pprInstr g@(GDIV sz src1 src2 dst)
1497 = pprG g (text "\t#GDIV-xxxcase1" $$
1498 hcat [gtab, gpush src2 0,
1499 text " ; fdivrp %st(0),", greg src1 1])
1501 = pprG g (text "\t#GDIV-xxxcase2" $$
1502 hcat [gtab, gpush src1 0,
1503 text " ; fdivp %st(0),", greg src2 1])
1505 = pprG g (hcat [gtab, gpush src1 0,
1506 text " ; fdiv ", greg src2 1, text ",%st(0)",
1511 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1512 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1515 --------------------------
1517 -- coerce %st(0) to the specified size
1518 gcoerceto F64 = empty
1519 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1522 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1524 = hcat [text "fstp ", greg reg offset]
1526 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1531 gregno (RealReg i) = i
1532 gregno other = --pprPanic "gregno" (ppr other)
1533 999 -- bogus; only needed for debug printing
1535 pprG :: Instr -> Doc -> Doc
1537 = (char '#' <> pprGInstr fake) $$ actual
1539 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1540 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1541 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1543 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1544 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1546 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1547 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1549 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1550 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1552 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1553 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1554 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1555 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1556 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1557 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1558 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1560 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1561 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1562 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1563 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1566 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1568 -- Continue with I386-only printing bits and bobs:
1570 pprDollImm :: Imm -> Doc
1572 pprDollImm i = ptext SLIT("$") <> pprImm i
1574 pprOperand :: MachRep -> Operand -> Doc
1575 pprOperand s (OpReg r) = pprReg s r
1576 pprOperand s (OpImm i) = pprDollImm i
1577 pprOperand s (OpAddr ea) = pprAddr ea
1579 pprMnemonic_ :: LitString -> Doc
1581 char '\t' <> ptext name <> space
1583 pprMnemonic :: LitString -> MachRep -> Doc
1584 pprMnemonic name size =
1585 char '\t' <> ptext name <> pprSize size <> space
1587 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1588 pprSizeImmOp name size imm op1
1590 pprMnemonic name size,
1597 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1598 pprSizeOp name size op1
1600 pprMnemonic name size,
1604 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1605 pprSizeOpOp name size op1 op2
1607 pprMnemonic name size,
1608 pprOperand size op1,
1613 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1614 pprOpOp name size op1 op2
1617 pprOperand size op1,
1622 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1623 pprSizeReg name size reg1
1625 pprMnemonic name size,
1629 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1630 pprSizeRegReg name size reg1 reg2
1632 pprMnemonic name size,
1638 pprRegReg :: LitString -> Reg -> Reg -> Doc
1639 pprRegReg name reg1 reg2
1642 pprReg wordRep reg1,
1647 pprOpReg :: LitString -> Operand -> Reg -> Doc
1648 pprOpReg name op1 reg2
1651 pprOperand wordRep op1,
1656 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1657 pprCondRegReg name size cond reg1 reg2
1668 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1669 pprSizeSizeRegReg name size1 size2 reg1 reg2
1682 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1683 pprSizeRegRegReg name size reg1 reg2 reg3
1685 pprMnemonic name size,
1693 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1694 pprSizeAddrReg name size op dst
1696 pprMnemonic name size,
1702 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1703 pprSizeRegAddr name size src op
1705 pprMnemonic name size,
1711 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1712 pprShift name size src dest
1714 pprMnemonic name size,
1715 pprOperand I8 src, -- src is 8-bit sized
1717 pprOperand size dest
1720 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1721 pprSizeOpOpCoerce name size1 size2 op1 op2
1722 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1723 pprOperand size1 op1,
1725 pprOperand size2 op2
1728 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1729 pprCondInstr name cond arg
1730 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1732 #endif /* i386_TARGET_ARCH */
1735 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1737 #if sparc_TARGET_ARCH
1739 -- a clumsy hack for now, to handle possible double alignment problems
1741 -- even clumsier, to allow for RegReg regs that show when doing indexed
1742 -- reads (bytearrays).
1745 -- Translate to the following:
1748 -- ld [g1+4],%f(n+1)
1749 -- sub g1,g2,g1 -- to restore g1
1750 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1752 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1753 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1754 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1755 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1760 -- ld [addr+4],%f(n+1)
1761 pprInstr (LD DF addr reg) | isJust off_addr
1763 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1764 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1767 off_addr = addrOffset addr 4
1768 addr2 = case off_addr of Just x -> x
1771 pprInstr (LD size addr reg)
1782 -- The same clumsy hack as above
1784 -- Translate to the following:
1787 -- st %f(n+1),[g1+4]
1788 -- sub g1,g2,g1 -- to restore g1
1789 pprInstr (ST DF reg (AddrRegReg g1 g2))
1791 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1792 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1794 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1795 pprReg g1, ptext SLIT("+4]")],
1796 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1801 -- st %f(n+1),[addr+4]
1802 pprInstr (ST DF reg addr) | isJust off_addr
1804 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1805 pprAddr addr, rbrack],
1806 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1807 pprAddr addr2, rbrack]
1810 off_addr = addrOffset addr 4
1811 addr2 = case off_addr of Just x -> x
1813 -- no distinction is made between signed and unsigned bytes on stores for the
1814 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1815 -- so we call a special-purpose pprSize for ST..
1817 pprInstr (ST size reg addr)
1828 pprInstr (ADD x cc reg1 ri reg2)
1829 | not x && not cc && riZero ri
1830 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1832 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1834 pprInstr (SUB x cc reg1 ri reg2)
1835 | not x && cc && reg2 == g0
1836 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1837 | not x && not cc && riZero ri
1838 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1840 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1842 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1843 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1845 pprInstr (OR b reg1 ri reg2)
1846 | not b && reg1 == g0
1847 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1849 RIReg rrr | rrr == reg2 -> empty
1852 = pprRegRIReg SLIT("or") b reg1 ri reg2
1854 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1856 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1857 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1859 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1860 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1861 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1863 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1864 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1865 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1867 pprInstr (SETHI imm reg)
1869 ptext SLIT("\tsethi\t"),
1875 pprInstr NOP = ptext SLIT("\tnop")
1877 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1878 pprInstr (FABS DF reg1 reg2)
1879 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1880 (if (reg1 == reg2) then empty
1881 else (<>) (char '\n')
1882 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1884 pprInstr (FADD size reg1 reg2 reg3)
1885 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1886 pprInstr (FCMP e size reg1 reg2)
1887 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1888 pprInstr (FDIV size reg1 reg2 reg3)
1889 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1891 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1892 pprInstr (FMOV DF reg1 reg2)
1893 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1894 (if (reg1 == reg2) then empty
1895 else (<>) (char '\n')
1896 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1898 pprInstr (FMUL size reg1 reg2 reg3)
1899 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1901 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1902 pprInstr (FNEG DF reg1 reg2)
1903 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1904 (if (reg1 == reg2) then empty
1905 else (<>) (char '\n')
1906 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1908 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1909 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1910 pprInstr (FxTOy size1 size2 reg1 reg2)
1923 pprReg reg1, comma, pprReg reg2
1927 pprInstr (BI cond b lab)
1929 ptext SLIT("\tb"), pprCond cond,
1930 if b then pp_comma_a else empty,
1935 pprInstr (BF cond b lab)
1937 ptext SLIT("\tfb"), pprCond cond,
1938 if b then pp_comma_a else empty,
1943 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1945 pprInstr (CALL (Left imm) n _)
1946 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1947 pprInstr (CALL (Right reg) n _)
1948 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1951 Continue with SPARC-only printing bits and bobs:
1954 pprRI (RIReg r) = pprReg r
1955 pprRI (RIImm r) = pprImm r
1957 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1958 pprSizeRegReg name size reg1 reg2
1963 F -> ptext SLIT("s\t")
1964 DF -> ptext SLIT("d\t")),
1970 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1971 pprSizeRegRegReg name size reg1 reg2 reg3
1976 F -> ptext SLIT("s\t")
1977 DF -> ptext SLIT("d\t")),
1985 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
1986 pprRegRIReg name b reg1 ri reg2
1990 if b then ptext SLIT("cc\t") else char '\t',
1998 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
1999 pprRIReg name b ri reg1
2003 if b then ptext SLIT("cc\t") else char '\t',
2009 pp_ld_lbracket = ptext SLIT("\tld\t[")
2010 pp_rbracket_comma = text "],"
2011 pp_comma_lbracket = text ",["
2012 pp_comma_a = text ",a"
2014 #endif /* sparc_TARGET_ARCH */
2017 -- -----------------------------------------------------------------------------
2018 -- pprInstr for PowerPC
2020 #if powerpc_TARGET_ARCH
2021 pprInstr (LD sz reg addr) = hcat [
2030 case addr of AddrRegImm _ _ -> empty
2031 AddrRegReg _ _ -> char 'x',
2037 pprInstr (LA sz reg addr) = hcat [
2046 case addr of AddrRegImm _ _ -> empty
2047 AddrRegReg _ _ -> char 'x',
2053 pprInstr (ST sz reg addr) = hcat [
2057 case addr of AddrRegImm _ _ -> empty
2058 AddrRegReg _ _ -> char 'x',
2064 pprInstr (STU sz reg addr) = hcat [
2069 case addr of AddrRegImm _ _ -> empty
2070 AddrRegReg _ _ -> char 'x',
2075 pprInstr (LIS reg imm) = hcat [
2083 pprInstr (LI reg imm) = hcat [
2091 pprInstr (MR reg1 reg2)
2092 | reg1 == reg2 = empty
2093 | otherwise = hcat [
2095 case regClass reg1 of
2096 RcInteger -> ptext SLIT("mr")
2097 _ -> ptext SLIT("fmr"),
2103 pprInstr (CMP sz reg ri) = hcat [
2119 pprInstr (CMPL sz reg ri) = hcat [
2135 pprInstr (BCC cond (BlockId id)) = hcat [
2142 where lbl = mkAsmTempLabel id
2144 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2151 pprInstr (MTCTR reg) = hcat [
2153 ptext SLIT("mtctr"),
2157 pprInstr (BCTR _) = hcat [
2161 pprInstr (BL lbl _) = hcat [
2162 ptext SLIT("\tbl\t"),
2165 pprInstr (BCTRL _) = hcat [
2169 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2170 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2172 ptext SLIT("addis"),
2181 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2182 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2183 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2184 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2185 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2186 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2187 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2189 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2190 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2191 pprReg reg2, ptext SLIT(", "),
2193 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2194 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2195 pprReg reg1, ptext SLIT(", "),
2196 ptext SLIT("2, 31, 31") ]
2199 -- for some reason, "andi" doesn't exist.
2200 -- we'll use "andi." instead.
2201 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2203 ptext SLIT("andi."),
2211 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2213 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2214 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2216 pprInstr (XORIS reg1 reg2 imm) = hcat [
2218 ptext SLIT("xoris"),
2227 pprInstr (EXTS sz reg1 reg2) = hcat [
2237 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2238 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2240 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2241 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2242 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2243 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2244 ptext SLIT("\trlwinm\t"),
2256 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2257 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2258 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2259 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2260 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2262 pprInstr (FCMP reg1 reg2) = hcat [
2264 ptext SLIT("fcmpu\tcr0, "),
2265 -- Note: we're using fcmpu, not fcmpo
2266 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2267 -- We don't handle invalid fp ops, so we don't care
2273 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2274 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2276 pprInstr (CRNOR dst src1 src2) = hcat [
2277 ptext SLIT("\tcrnor\t"),
2285 pprInstr (MFCR reg) = hcat [
2292 pprInstr (MFLR reg) = hcat [
2299 pprInstr (FETCHPC reg) = vcat [
2300 ptext SLIT("\tbcl\t20,31,1f"),
2301 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2304 pprInstr _ = panic "pprInstr (ppc)"
2306 pprLogic op reg1 reg2 ri = hcat [
2311 RIImm _ -> char 'i',
2320 pprUnary op reg1 reg2 = hcat [
2329 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2342 pprRI (RIReg r) = pprReg r
2343 pprRI (RIImm r) = pprImm r
2345 pprFSize F64 = empty
2346 pprFSize F32 = char 's'
2348 -- limit immediate argument for shift instruction to range 0..32
2349 -- (yes, the maximum is really 32, not 31)
2350 limitShiftRI :: RI -> RI
2351 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2354 #endif /* powerpc_TARGET_ARCH */
2357 -- -----------------------------------------------------------------------------
2358 -- Converting floating-point literals to integrals for printing
2360 #if __GLASGOW_HASKELL__ >= 504
2361 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
2362 newFloatArray = newArray_
2364 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
2365 newDoubleArray = newArray_
2367 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2368 castFloatToCharArray = castSTUArray
2370 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2371 castDoubleToCharArray = castSTUArray
2373 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
2374 writeFloatArray = writeArray
2376 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
2377 writeDoubleArray = writeArray
2379 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
2380 readCharArray arr i = do
2381 w <- readArray arr i
2382 return $! (chr (fromIntegral w))
2386 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2387 castFloatToCharArray = return
2389 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2392 castDoubleToCharArray = return
2396 -- floatToBytes and doubleToBytes convert to the host's byte
2397 -- order. Providing that we're not cross-compiling for a
2398 -- target with the opposite endianness, this should work ok
2401 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2402 -- could they be merged?
2404 floatToBytes :: Float -> [Int]
2407 arr <- newFloatArray ((0::Int),3)
2408 writeFloatArray arr 0 f
2409 arr <- castFloatToCharArray arr
2410 i0 <- readCharArray arr 0
2411 i1 <- readCharArray arr 1
2412 i2 <- readCharArray arr 2
2413 i3 <- readCharArray arr 3
2414 return (map ord [i0,i1,i2,i3])
2417 doubleToBytes :: Double -> [Int]
2420 arr <- newDoubleArray ((0::Int),7)
2421 writeDoubleArray arr 0 d
2422 arr <- castDoubleToCharArray arr
2423 i0 <- readCharArray arr 0
2424 i1 <- readCharArray arr 1
2425 i2 <- readCharArray arr 2
2426 i3 <- readCharArray arr 3
2427 i4 <- readCharArray arr 4
2428 i5 <- readCharArray arr 5
2429 i6 <- readCharArray arr 6
2430 i7 <- readCharArray arr 7
2431 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])