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 ALWAYS -> SLIT("mp") -- hack
451 #if sparc_TARGET_ARCH
452 ALWAYS -> SLIT(""); NEVER -> SLIT("n");
453 GEU -> SLIT("geu"); LU -> SLIT("lu");
454 EQQ -> SLIT("e"); GTT -> SLIT("g");
455 GE -> SLIT("ge"); GU -> SLIT("gu");
456 LTT -> SLIT("l"); LE -> SLIT("le");
457 LEU -> SLIT("leu"); NE -> SLIT("ne");
458 NEG -> SLIT("neg"); POS -> SLIT("pos");
459 VC -> SLIT("vc"); VS -> SLIT("vs")
461 #if powerpc_TARGET_ARCH
463 EQQ -> SLIT("eq"); NE -> SLIT("ne");
464 LTT -> SLIT("lt"); GE -> SLIT("ge");
465 GTT -> SLIT("gt"); LE -> SLIT("le");
466 LU -> SLIT("lt"); GEU -> SLIT("ge");
467 GU -> SLIT("gt"); LEU -> SLIT("le");
472 -- -----------------------------------------------------------------------------
473 -- pprImm: print an 'Imm'
477 pprImm (ImmInt i) = int i
478 pprImm (ImmInteger i) = integer i
479 pprImm (ImmCLbl l) = pprCLabel_asm l
480 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
481 pprImm (ImmLit s) = s
483 pprImm (ImmFloat _) = panic "pprImm:ImmFloat"
484 pprImm (ImmDouble _) = panic "pprImm:ImmDouble"
486 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
487 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
488 <> lparen <> pprImm b <> rparen
490 #if sparc_TARGET_ARCH
492 = hcat [ pp_lo, pprImm i, rparen ]
497 = hcat [ pp_hi, pprImm i, rparen ]
501 #if powerpc_TARGET_ARCH
504 = hcat [ pp_lo, pprImm i, rparen ]
509 = hcat [ pp_hi, pprImm i, rparen ]
514 = hcat [ pp_ha, pprImm i, rparen ]
520 = pprImm i <> text "@l"
523 = pprImm i <> text "@h"
526 = pprImm i <> text "@ha"
531 -- -----------------------------------------------------------------------------
532 -- @pprAddr: print an 'AddrMode'
534 pprAddr :: AddrMode -> Doc
536 #if alpha_TARGET_ARCH
537 pprAddr (AddrReg r) = parens (pprReg r)
538 pprAddr (AddrImm i) = pprImm i
539 pprAddr (AddrRegImm r1 i)
540 = (<>) (pprImm i) (parens (pprReg r1))
545 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
546 pprAddr (ImmAddr imm off)
547 = let pp_imm = pprImm imm
551 else if (off < 0) then
554 pp_imm <> char '+' <> int off
556 pprAddr (AddrBaseIndex base index displacement)
558 pp_disp = ppr_disp displacement
559 pp_off p = pp_disp <> char '(' <> p <> char ')'
560 pp_reg r = pprReg wordRep r
563 (Nothing, Nothing) -> pp_disp
564 (Just b, Nothing) -> pp_off (pp_reg b)
565 (Nothing, Just (r,i)) -> pp_off (comma <> pp_reg r <> comma <> int i)
566 (Just b, Just (r,i)) -> pp_off (pp_reg b <> comma <> pp_reg r
569 ppr_disp (ImmInt 0) = empty
570 ppr_disp imm = pprImm imm
575 #if sparc_TARGET_ARCH
576 pprAddr (AddrRegReg r1 (RealReg 0)) = pprReg r1
578 pprAddr (AddrRegReg r1 r2)
579 = hcat [ pprReg r1, char '+', pprReg r2 ]
581 pprAddr (AddrRegImm r1 (ImmInt i))
583 | not (fits13Bits i) = largeOffsetError i
584 | otherwise = hcat [ pprReg r1, pp_sign, int i ]
586 pp_sign = if i > 0 then char '+' else empty
588 pprAddr (AddrRegImm r1 (ImmInteger i))
590 | not (fits13Bits i) = largeOffsetError i
591 | otherwise = hcat [ pprReg r1, pp_sign, integer i ]
593 pp_sign = if i > 0 then char '+' else empty
595 pprAddr (AddrRegImm r1 imm)
596 = hcat [ pprReg r1, char '+', pprImm imm ]
601 #if powerpc_TARGET_ARCH
602 pprAddr (AddrRegReg r1 r2)
603 = pprReg r1 <+> ptext SLIT(", ") <+> pprReg r2
605 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
606 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
607 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
611 -- -----------------------------------------------------------------------------
612 -- pprData: print a 'CmmStatic'
614 pprSectionHeader Text
616 IF_ARCH_alpha(SLIT("\t.text\n\t.align 3") {-word boundary-}
617 ,IF_ARCH_sparc(SLIT(".text\n\t.align 4") {-word boundary-}
618 ,IF_ARCH_i386(SLIT(".text\n\t.align 4,0x90") {-needs per-OS variation!-}
619 ,IF_ARCH_x86_64(SLIT(".text\n\t.align 8") {-needs per-OS variation!-}
620 ,IF_ARCH_powerpc(SLIT(".text\n.align 2")
622 pprSectionHeader Data
624 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
625 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
626 ,IF_ARCH_i386(SLIT(".data\n\t.align 4")
627 ,IF_ARCH_x86_64(SLIT(".data\n\t.align 8")
628 ,IF_ARCH_powerpc(SLIT(".data\n.align 2")
630 pprSectionHeader ReadOnlyData
632 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
633 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
634 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
635 ,IF_ARCH_x86_64(SLIT(".section .rodata\n\t.align 8")
636 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 2"),
637 SLIT(".section .rodata\n\t.align 2"))
639 pprSectionHeader RelocatableReadOnlyData
641 IF_ARCH_alpha(SLIT("\t.data\n\t.align 3")
642 ,IF_ARCH_sparc(SLIT(".data\n\t.align 8") {-<8 will break double constants -}
643 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 4")
644 ,IF_ARCH_x86_64(SLIT(".text\n\t.align 8")
645 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
646 SLIT(".data\n\t.align 2"))
648 -- the assembler on x86_64/Linux refuses to generate code for
650 -- where x is in the text section and y in the rodata section.
651 -- It works if y is in the text section, though. This is probably
652 -- going to cause difficulties for PIC, I imagine.
653 pprSectionHeader UninitialisedData
655 IF_ARCH_alpha(SLIT("\t.bss\n\t.align 3")
656 ,IF_ARCH_sparc(SLIT(".bss\n\t.align 8") {-<8 will break double constants -}
657 ,IF_ARCH_i386(SLIT(".section .bss\n\t.align 4")
658 ,IF_ARCH_x86_64(SLIT(".section .bss\n\t.align 8")
659 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const_data\n.align 2"),
660 SLIT(".section .bss\n\t.align 2"))
662 pprSectionHeader ReadOnlyData16
664 IF_ARCH_alpha(SLIT("\t.data\n\t.align 4")
665 ,IF_ARCH_sparc(SLIT(".data\n\t.align 16")
666 ,IF_ARCH_i386(SLIT(".section .rodata\n\t.align 16")
667 ,IF_ARCH_x86_64(SLIT(".section .rodata.cst16\n\t.align 16")
668 ,IF_ARCH_powerpc(IF_OS_darwin(SLIT(".const\n.align 4"),
669 SLIT(".section .rodata\n\t.align 4"))
672 pprSectionHeader (OtherSection sec)
673 = panic "PprMach.pprSectionHeader: unknown section"
675 pprData :: CmmStatic -> Doc
676 pprData (CmmAlign bytes) = pprAlign bytes
677 pprData (CmmDataLabel lbl) = pprLabel lbl
678 pprData (CmmString str) = pprASCII str
679 pprData (CmmUninitialised bytes) = ptext SLIT(".space ") <> int bytes
680 pprData (CmmStaticLit lit) = pprDataItem lit
682 pprGloblDecl :: CLabel -> Doc
684 | not (externallyVisibleCLabel lbl) = empty
685 | otherwise = ptext IF_ARCH_sparc(SLIT(".global "),
689 pprLabel :: CLabel -> Doc
690 pprLabel lbl = pprGloblDecl lbl $$ (pprCLabel_asm lbl <> char ':')
693 -- Assume we want to backslash-convert the string
695 = vcat (map do1 (str ++ [chr 0]))
698 do1 c = ptext SLIT("\t.byte\t0x") <> hshow (ord c)
701 hshow n | n >= 0 && n <= 255
702 = char (tab !! (n `div` 16)) <> char (tab !! (n `mod` 16))
703 tab = "0123456789ABCDEF"
706 IF_ARCH_alpha(ptextSLIT(".align ") <> int pow2,
707 IF_ARCH_i386(ptext SLIT(".align ") <> int bytes,
708 IF_ARCH_x86_64(ptext SLIT(".align ") <> int bytes,
709 IF_ARCH_sparc(ptext SLIT(".align ") <> int bytes,
710 IF_ARCH_powerpc(ptext SLIT(".align ") <> int pow2,)))))
714 log2 :: Int -> Int -- cache the common ones
719 log2 n = 1 + log2 (n `quot` 2)
722 pprDataItem :: CmmLit -> Doc
724 = vcat (ppr_item (cmmLitRep lit) lit)
728 -- These seem to be common:
729 ppr_item I8 x = [ptext SLIT("\t.byte\t") <> pprImm imm]
730 ppr_item I32 x = [ptext SLIT("\t.long\t") <> pprImm imm]
731 ppr_item F32 (CmmFloat r _)
732 = let bs = floatToBytes (fromRational r)
733 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
734 ppr_item F64 (CmmFloat r _)
735 = let bs = doubleToBytes (fromRational r)
736 in map (\b -> ptext SLIT("\t.byte\t") <> pprImm (ImmInt b)) bs
738 #if sparc_TARGET_ARCH
739 -- copy n paste of x86 version
740 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
741 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
743 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
744 ppr_item I16 x = [ptext SLIT("\t.word\t") <> pprImm imm]
745 ppr_item I64 x = [ptext SLIT("\t.quad\t") <> pprImm imm]
747 #if powerpc_TARGET_ARCH
748 ppr_item I16 x = [ptext SLIT("\t.short\t") <> pprImm imm]
749 ppr_item I64 (CmmInt x _) =
750 [ptext SLIT("\t.long\t")
752 (fromIntegral (x `shiftR` 32) :: Word32)),
753 ptext SLIT("\t.long\t")
754 <> int (fromIntegral (fromIntegral x :: Word32))]
757 -- fall through to rest of (machine-specific) pprInstr...
759 -- -----------------------------------------------------------------------------
760 -- pprInstr: print an 'Instr'
762 pprInstr :: Instr -> Doc
764 --pprInstr (COMMENT s) = empty -- nuke 'em
766 = IF_ARCH_alpha( ((<>) (ptext SLIT("\t# ")) (ftext s))
767 ,IF_ARCH_sparc( ((<>) (ptext SLIT("! ")) (ftext s))
768 ,IF_ARCH_i386( ((<>) (ptext SLIT("# ")) (ftext s))
769 ,IF_ARCH_x86_64( ((<>) (ptext SLIT("# ")) (ftext s))
770 ,IF_ARCH_powerpc( IF_OS_linux(
771 ((<>) (ptext SLIT("# ")) (ftext s)),
772 ((<>) (ptext SLIT("; ")) (ftext s)))
776 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
778 pprInstr (NEWBLOCK _)
779 = panic "PprMach.pprInstr: NEWBLOCK"
782 = panic "PprMach.pprInstr: LDATA"
784 -- -----------------------------------------------------------------------------
785 -- pprInstr for an Alpha
787 #if alpha_TARGET_ARCH
789 pprInstr (LD size reg addr)
799 pprInstr (LDA reg addr)
801 ptext SLIT("\tlda\t"),
807 pprInstr (LDAH reg addr)
809 ptext SLIT("\tldah\t"),
815 pprInstr (LDGP reg addr)
817 ptext SLIT("\tldgp\t"),
823 pprInstr (LDI size reg imm)
833 pprInstr (ST size reg addr)
845 ptext SLIT("\tclr\t"),
849 pprInstr (ABS size ri reg)
859 pprInstr (NEG size ov ri reg)
863 if ov then ptext SLIT("v\t") else char '\t',
869 pprInstr (ADD size ov reg1 ri reg2)
873 if ov then ptext SLIT("v\t") else char '\t',
881 pprInstr (SADD size scale reg1 ri reg2)
883 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
894 pprInstr (SUB size ov reg1 ri reg2)
898 if ov then ptext SLIT("v\t") else char '\t',
906 pprInstr (SSUB size scale reg1 ri reg2)
908 ptext (case scale of {{-UNUSED:L -> SLIT("\ts4");-} Q -> SLIT("\ts8")}),
919 pprInstr (MUL size ov reg1 ri reg2)
923 if ov then ptext SLIT("v\t") else char '\t',
931 pprInstr (DIV size uns reg1 ri reg2)
935 if uns then ptext SLIT("u\t") else char '\t',
943 pprInstr (REM size uns reg1 ri reg2)
947 if uns then ptext SLIT("u\t") else char '\t',
955 pprInstr (NOT ri reg)
964 pprInstr (AND reg1 ri reg2) = pprRegRIReg SLIT("and") reg1 ri reg2
965 pprInstr (ANDNOT reg1 ri reg2) = pprRegRIReg SLIT("andnot") reg1 ri reg2
966 pprInstr (OR reg1 ri reg2) = pprRegRIReg SLIT("or") reg1 ri reg2
967 pprInstr (ORNOT reg1 ri reg2) = pprRegRIReg SLIT("ornot") reg1 ri reg2
968 pprInstr (XOR reg1 ri reg2) = pprRegRIReg SLIT("xor") reg1 ri reg2
969 pprInstr (XORNOT reg1 ri reg2) = pprRegRIReg SLIT("xornot") reg1 ri reg2
971 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") reg1 ri reg2
972 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") reg1 ri reg2
973 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") reg1 ri reg2
975 pprInstr (ZAP reg1 ri reg2) = pprRegRIReg SLIT("zap") reg1 ri reg2
976 pprInstr (ZAPNOT reg1 ri reg2) = pprRegRIReg SLIT("zapnot") reg1 ri reg2
978 pprInstr (NOP) = ptext SLIT("\tnop")
980 pprInstr (CMP cond reg1 ri reg2)
994 ptext SLIT("\tfclr\t"),
998 pprInstr (FABS reg1 reg2)
1000 ptext SLIT("\tfabs\t"),
1006 pprInstr (FNEG size reg1 reg2)
1008 ptext SLIT("\tneg"),
1016 pprInstr (FADD size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("add") size reg1 reg2 reg3
1017 pprInstr (FDIV size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("div") size reg1 reg2 reg3
1018 pprInstr (FMUL size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("mul") size reg1 reg2 reg3
1019 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("sub") size reg1 reg2 reg3
1021 pprInstr (CVTxy size1 size2 reg1 reg2)
1023 ptext SLIT("\tcvt"),
1025 case size2 of {Q -> ptext SLIT("qc"); _ -> pprSize size2},
1032 pprInstr (FCMP size cond reg1 reg2 reg3)
1034 ptext SLIT("\tcmp"),
1045 pprInstr (FMOV reg1 reg2)
1047 ptext SLIT("\tfmov\t"),
1053 pprInstr (BI ALWAYS reg lab) = pprInstr (BR lab)
1055 pprInstr (BI NEVER reg lab) = empty
1057 pprInstr (BI cond reg lab)
1067 pprInstr (BF cond reg lab)
1078 = (<>) (ptext SLIT("\tbr\t")) (pprImm lab)
1080 pprInstr (JMP reg addr hint)
1082 ptext SLIT("\tjmp\t"),
1090 pprInstr (BSR imm n)
1091 = (<>) (ptext SLIT("\tbsr\t")) (pprImm imm)
1093 pprInstr (JSR reg addr n)
1095 ptext SLIT("\tjsr\t"),
1101 pprInstr (FUNBEGIN clab)
1103 if (externallyVisibleCLabel clab) then
1104 hcat [ptext SLIT("\t.globl\t"), pp_lab, char '\n']
1107 ptext SLIT("\t.ent "),
1116 pp_lab = pprCLabel_asm clab
1118 -- NEVER use commas within those string literals, cpp will ruin your day
1119 pp_ldgp = hcat [ ptext SLIT(":\n\tldgp $29"), char ',', ptext SLIT("0($27)\n") ]
1120 pp_frame = hcat [ ptext SLIT("..ng:\n\t.frame $30"), char ',',
1121 ptext SLIT("4240"), char ',',
1122 ptext SLIT("$26"), char ',',
1123 ptext SLIT("0\n\t.prologue 1") ]
1125 pprInstr (FUNEND clab)
1126 = (<>) (ptext SLIT("\t.align 4\n\t.end ")) (pprCLabel_asm clab)
1129 Continue with Alpha-only printing bits and bobs:
1133 pprRI (RIReg r) = pprReg r
1134 pprRI (RIImm r) = pprImm r
1136 pprRegRIReg :: LitString -> Reg -> RI -> Reg -> Doc
1137 pprRegRIReg name reg1 ri reg2
1149 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1150 pprSizeRegRegReg name size reg1 reg2 reg3
1163 #endif /* alpha_TARGET_ARCH */
1166 -- -----------------------------------------------------------------------------
1167 -- pprInstr for an x86
1169 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1171 pprInstr v@(MOV size s@(OpReg src) d@(OpReg dst)) -- hack
1174 #if 0 /* #ifdef DEBUG */
1175 (<>) (ptext SLIT("# warning: ")) (pprSizeOpOp SLIT("mov") size s d)
1180 pprInstr (MOV size src dst)
1181 = pprSizeOpOp SLIT("mov") size src dst
1183 pprInstr (MOVZxL I32 src dst) = pprSizeOpOp SLIT("mov") I32 src dst
1184 -- 32-to-64 bit zero extension on x86_64 is accomplished by a simple
1185 -- movl. But we represent it as a MOVZxL instruction, because
1186 -- the reg alloc would tend to throw away a plain reg-to-reg
1187 -- move, and we still want it to do that.
1189 pprInstr (MOVZxL sizes src dst) = pprSizeOpOpCoerce SLIT("movz") sizes wordRep src dst
1190 pprInstr (MOVSxL sizes src dst) = pprSizeOpOpCoerce SLIT("movs") sizes wordRep src dst
1192 -- here we do some patching, since the physical registers are only set late
1193 -- in the code generation.
1194 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1196 = pprSizeOpOp SLIT("add") size (OpReg reg2) dst
1197 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) (Just (reg2,1)) (ImmInt 0))) dst@(OpReg reg3))
1199 = pprSizeOpOp SLIT("add") size (OpReg reg1) dst
1200 pprInstr (LEA size (OpAddr (AddrBaseIndex src1@(Just reg1) Nothing displ)) dst@(OpReg reg3))
1202 = pprInstr (ADD size (OpImm displ) dst)
1203 pprInstr (LEA size src dst) = pprSizeOpOp SLIT("lea") size src dst
1205 pprInstr (ADD size (OpImm (ImmInt (-1))) dst)
1206 = pprSizeOp SLIT("dec") size dst
1207 pprInstr (ADD size (OpImm (ImmInt 1)) dst)
1208 = pprSizeOp SLIT("inc") size dst
1209 pprInstr (ADD size src dst)
1210 = pprSizeOpOp SLIT("add") size src dst
1211 pprInstr (ADC size src dst)
1212 = pprSizeOpOp SLIT("adc") size src dst
1213 pprInstr (SUB size src dst) = pprSizeOpOp SLIT("sub") size src dst
1214 pprInstr (IMUL size op1 op2) = pprSizeOpOp SLIT("imul") size op1 op2
1216 {- A hack. The Intel documentation says that "The two and three
1217 operand forms [of IMUL] may also be used with unsigned operands
1218 because the lower half of the product is the same regardless if
1219 (sic) the operands are signed or unsigned. The CF and OF flags,
1220 however, cannot be used to determine if the upper half of the
1221 result is non-zero." So there.
1223 pprInstr (AND size src dst) = pprSizeOpOp SLIT("and") size src dst
1224 pprInstr (OR size src dst) = pprSizeOpOp SLIT("or") size src dst
1226 pprInstr (XOR F32 src dst) = pprOpOp SLIT("xorps") F32 src dst
1227 pprInstr (XOR F64 src dst) = pprOpOp SLIT("xorpd") F64 src dst
1228 pprInstr (XOR size src dst) = pprSizeOpOp SLIT("xor") size src dst
1230 pprInstr (NOT size op) = pprSizeOp SLIT("not") size op
1231 pprInstr (NEGI size op) = pprSizeOp SLIT("neg") size op
1233 pprInstr (SHL size src dst) = pprShift SLIT("shl") size src dst
1234 pprInstr (SAR size src dst) = pprShift SLIT("sar") size src dst
1235 pprInstr (SHR size src dst) = pprShift SLIT("shr") size src dst
1237 pprInstr (BT size imm src) = pprSizeImmOp SLIT("bt") size imm src
1239 pprInstr (CMP size src dst)
1240 | isFloatingRep size = pprSizeOpOp SLIT("ucomi") size src dst -- SSE2
1241 | otherwise = pprSizeOpOp SLIT("cmp") size src dst
1243 pprInstr (TEST size src dst) = pprSizeOpOp SLIT("test") size src dst
1244 pprInstr (PUSH size op) = pprSizeOp SLIT("push") size op
1245 pprInstr (POP size op) = pprSizeOp SLIT("pop") size op
1247 -- both unused (SDM):
1248 -- pprInstr PUSHA = ptext SLIT("\tpushal")
1249 -- pprInstr POPA = ptext SLIT("\tpopal")
1251 pprInstr NOP = ptext SLIT("\tnop")
1252 pprInstr (CLTD I32) = ptext SLIT("\tcltd")
1253 pprInstr (CLTD I64) = ptext SLIT("\tcqto")
1255 pprInstr (SETCC cond op) = pprCondInstr SLIT("set") cond (pprOperand I8 op)
1257 pprInstr (JXX cond (BlockId id))
1258 = pprCondInstr SLIT("j") cond (pprCLabel_asm lab)
1259 where lab = mkAsmTempLabel id
1261 pprInstr (JMP (OpImm imm)) = (<>) (ptext SLIT("\tjmp ")) (pprImm imm)
1262 pprInstr (JMP op) = (<>) (ptext SLIT("\tjmp *")) (pprOperand wordRep op)
1263 pprInstr (JMP_TBL op ids) = pprInstr (JMP op)
1264 pprInstr (CALL (Left imm)) = (<>) (ptext SLIT("\tcall ")) (pprImm imm)
1265 pprInstr (CALL (Right reg)) = (<>) (ptext SLIT("\tcall *")) (pprReg wordRep reg)
1267 pprInstr (IDIV sz op) = pprSizeOp SLIT("idiv") sz op
1268 pprInstr (DIV sz op) = pprSizeOp SLIT("div") sz op
1270 pprInstr (IMUL64 sd_hi sd_lo) = pprInstr_imul64 sd_hi sd_lo
1272 #if x86_64_TARGET_ARCH
1273 pprInstr (MUL size op1 op2) = pprSizeOpOp SLIT("mul") size op1 op2
1275 pprInstr (FDIV size op1 op2) = pprSizeOpOp SLIT("div") size op1 op2
1277 pprInstr (CVTSS2SD from to) = pprRegReg SLIT("cvtss2sd") from to
1278 pprInstr (CVTSD2SS from to) = pprRegReg SLIT("cvtsd2ss") from to
1279 pprInstr (CVTSS2SI from to) = pprOpReg SLIT("cvtss2si") from to
1280 pprInstr (CVTSD2SI from to) = pprOpReg SLIT("cvtsd2si") from to
1281 pprInstr (CVTSI2SS from to) = pprOpReg SLIT("cvtsi2ss") from to
1282 pprInstr (CVTSI2SD from to) = pprOpReg SLIT("cvtsi2sd") from to
1285 pprInstr (FETCHGOT reg)
1286 = vcat [ ptext SLIT("\tcall 1f"),
1287 hcat [ ptext SLIT("1:\tpopl\t"), pprReg I32 reg ],
1288 hcat [ ptext SLIT("\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), "),
1294 -- -----------------------------------------------------------------------------
1295 -- i386 floating-point
1297 #if i386_TARGET_ARCH
1298 -- Simulating a flat register set on the x86 FP stack is tricky.
1299 -- you have to free %st(7) before pushing anything on the FP reg stack
1300 -- so as to preclude the possibility of a FP stack overflow exception.
1301 pprInstr g@(GMOV src dst)
1305 = pprG g (hcat [gtab, gpush src 0, gsemi, gpop dst 1])
1307 -- GLD sz addr dst ==> FFREE %st(7) ; FLDsz addr ; FSTP (dst+1)
1308 pprInstr g@(GLD sz addr dst)
1309 = pprG g (hcat [gtab, text "ffree %st(7) ; fld", pprSize sz, gsp,
1310 pprAddr addr, gsemi, gpop dst 1])
1312 -- GST sz src addr ==> FFREE %st(7) ; FLD dst ; FSTPsz addr
1313 pprInstr g@(GST sz src addr)
1314 = pprG g (hcat [gtab, gpush src 0, gsemi,
1315 text "fstp", pprSize sz, gsp, pprAddr addr])
1317 pprInstr g@(GLDZ dst)
1318 = pprG g (hcat [gtab, text "ffree %st(7) ; fldz ; ", gpop dst 1])
1319 pprInstr g@(GLD1 dst)
1320 = pprG g (hcat [gtab, text "ffree %st(7) ; fld1 ; ", gpop dst 1])
1322 pprInstr g@(GFTOI src dst)
1323 = pprInstr (GDTOI src dst)
1324 pprInstr g@(GDTOI src dst)
1325 = pprG g (hcat [gtab, text "subl $4, %esp ; ",
1326 gpush src 0, gsemi, text "fistpl 0(%esp) ; popl ",
1329 pprInstr g@(GITOF src dst)
1330 = pprInstr (GITOD src dst)
1331 pprInstr g@(GITOD src dst)
1332 = pprG g (hcat [gtab, text "pushl ", pprReg I32 src,
1333 text " ; ffree %st(7); fildl (%esp) ; ",
1334 gpop dst 1, text " ; addl $4,%esp"])
1336 {- Gruesome swamp follows. If you're unfortunate enough to have ventured
1337 this far into the jungle AND you give a Rat's Ass (tm) what's going
1338 on, here's the deal. Generate code to do a floating point comparison
1339 of src1 and src2, of kind cond, and set the Zero flag if true.
1341 The complications are to do with handling NaNs correctly. We want the
1342 property that if either argument is NaN, then the result of the
1343 comparison is False ... except if we're comparing for inequality,
1344 in which case the answer is True.
1346 Here's how the general (non-inequality) case works. As an
1347 example, consider generating the an equality test:
1349 pushl %eax -- we need to mess with this
1350 <get src1 to top of FPU stack>
1351 fcomp <src2 location in FPU stack> and pop pushed src1
1352 -- Result of comparison is in FPU Status Register bits
1354 fstsw %ax -- Move FPU Status Reg to %ax
1355 sahf -- move C3 C2 C0 from %ax to integer flag reg
1356 -- now the serious magic begins
1357 setpo %ah -- %ah = if comparable(neither arg was NaN) then 1 else 0
1358 sete %al -- %al = if arg1 == arg2 then 1 else 0
1359 andb %ah,%al -- %al &= %ah
1360 -- so %al == 1 iff (comparable && same); else it holds 0
1361 decb %al -- %al == 0, ZeroFlag=1 iff (comparable && same);
1362 else %al == 0xFF, ZeroFlag=0
1363 -- the zero flag is now set as we desire.
1366 The special case of inequality differs thusly:
1368 setpe %ah -- %ah = if incomparable(either arg was NaN) then 1 else 0
1369 setne %al -- %al = if arg1 /= arg2 then 1 else 0
1370 orb %ah,%al -- %al = if (incomparable || different) then 1 else 0
1371 decb %al -- if (incomparable || different) then (%al == 0, ZF=1)
1372 else (%al == 0xFF, ZF=0)
1374 pprInstr g@(GCMP cond src1 src2)
1375 | case cond of { NE -> True; other -> False }
1377 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1378 hcat [gtab, text "fcomp ", greg src2 1,
1379 text "; fstsw %ax ; sahf ; setpe %ah"],
1380 hcat [gtab, text "setne %al ; ",
1381 text "orb %ah,%al ; decb %al ; popl %eax"]
1385 hcat [gtab, text "pushl %eax ; ",gpush src1 0],
1386 hcat [gtab, text "fcomp ", greg src2 1,
1387 text "; fstsw %ax ; sahf ; setpo %ah"],
1388 hcat [gtab, text "set", pprCond (fix_FP_cond cond), text " %al ; ",
1389 text "andb %ah,%al ; decb %al ; popl %eax"]
1392 {- On the 486, the flags set by FP compare are the unsigned ones!
1393 (This looks like a HACK to me. WDP 96/03)
1395 fix_FP_cond :: Cond -> Cond
1396 fix_FP_cond GE = GEU
1397 fix_FP_cond GTT = GU
1398 fix_FP_cond LTT = LU
1399 fix_FP_cond LE = LEU
1400 fix_FP_cond EQQ = EQQ
1402 -- there should be no others
1405 pprInstr g@(GABS sz src dst)
1406 = pprG g (hcat [gtab, gpush src 0, text " ; fabs ; ", gpop dst 1])
1407 pprInstr g@(GNEG sz src dst)
1408 = pprG g (hcat [gtab, gpush src 0, text " ; fchs ; ", gpop dst 1])
1410 pprInstr g@(GSQRT sz src dst)
1411 = pprG g (hcat [gtab, gpush src 0, text " ; fsqrt"] $$
1412 hcat [gtab, gcoerceto sz, gpop dst 1])
1413 pprInstr g@(GSIN sz src dst)
1414 = pprG g (hcat [gtab, gpush src 0, text " ; fsin"] $$
1415 hcat [gtab, gcoerceto sz, gpop dst 1])
1416 pprInstr g@(GCOS sz src dst)
1417 = pprG g (hcat [gtab, gpush src 0, text " ; fcos"] $$
1418 hcat [gtab, gcoerceto sz, gpop dst 1])
1419 pprInstr g@(GTAN sz src dst)
1420 = pprG g (hcat [gtab, text "ffree %st(6) ; ",
1421 gpush src 0, text " ; fptan ; ",
1422 text " fstp %st(0)"] $$
1423 hcat [gtab, gcoerceto sz, gpop dst 1])
1425 -- In the translations for GADD, GMUL, GSUB and GDIV,
1426 -- the first two cases are mere optimisations. The otherwise clause
1427 -- generates correct code under all circumstances.
1429 pprInstr g@(GADD sz src1 src2 dst)
1431 = pprG g (text "\t#GADD-xxxcase1" $$
1432 hcat [gtab, gpush src2 0,
1433 text " ; faddp %st(0),", greg src1 1])
1435 = pprG g (text "\t#GADD-xxxcase2" $$
1436 hcat [gtab, gpush src1 0,
1437 text " ; faddp %st(0),", greg src2 1])
1439 = pprG g (hcat [gtab, gpush src1 0,
1440 text " ; fadd ", greg src2 1, text ",%st(0)",
1444 pprInstr g@(GMUL sz src1 src2 dst)
1446 = pprG g (text "\t#GMUL-xxxcase1" $$
1447 hcat [gtab, gpush src2 0,
1448 text " ; fmulp %st(0),", greg src1 1])
1450 = pprG g (text "\t#GMUL-xxxcase2" $$
1451 hcat [gtab, gpush src1 0,
1452 text " ; fmulp %st(0),", greg src2 1])
1454 = pprG g (hcat [gtab, gpush src1 0,
1455 text " ; fmul ", greg src2 1, text ",%st(0)",
1459 pprInstr g@(GSUB sz src1 src2 dst)
1461 = pprG g (text "\t#GSUB-xxxcase1" $$
1462 hcat [gtab, gpush src2 0,
1463 text " ; fsubrp %st(0),", greg src1 1])
1465 = pprG g (text "\t#GSUB-xxxcase2" $$
1466 hcat [gtab, gpush src1 0,
1467 text " ; fsubp %st(0),", greg src2 1])
1469 = pprG g (hcat [gtab, gpush src1 0,
1470 text " ; fsub ", greg src2 1, text ",%st(0)",
1474 pprInstr g@(GDIV sz src1 src2 dst)
1476 = pprG g (text "\t#GDIV-xxxcase1" $$
1477 hcat [gtab, gpush src2 0,
1478 text " ; fdivrp %st(0),", greg src1 1])
1480 = pprG g (text "\t#GDIV-xxxcase2" $$
1481 hcat [gtab, gpush src1 0,
1482 text " ; fdivp %st(0),", greg src2 1])
1484 = pprG g (hcat [gtab, gpush src1 0,
1485 text " ; fdiv ", greg src2 1, text ",%st(0)",
1490 = vcat [ ptext SLIT("\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)"),
1491 ptext SLIT("\tffree %st(4) ;ffree %st(5) ;ffree %st(6) ;ffree %st(7)")
1494 --------------------------
1496 -- coerce %st(0) to the specified size
1497 gcoerceto F64 = empty
1498 gcoerceto F32 = empty --text "subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ; "
1501 = hcat [text "ffree %st(7) ; fld ", greg reg offset]
1503 = hcat [text "fstp ", greg reg offset]
1505 greg reg offset = text "%st(" <> int (gregno reg - 8+offset) <> char ')'
1510 gregno (RealReg i) = i
1511 gregno other = --pprPanic "gregno" (ppr other)
1512 999 -- bogus; only needed for debug printing
1514 pprG :: Instr -> Doc -> Doc
1516 = (char '#' <> pprGInstr fake) $$ actual
1518 pprGInstr (GMOV src dst) = pprSizeRegReg SLIT("gmov") F64 src dst
1519 pprGInstr (GLD sz src dst) = pprSizeAddrReg SLIT("gld") sz src dst
1520 pprGInstr (GST sz src dst) = pprSizeRegAddr SLIT("gst") sz src dst
1522 pprGInstr (GLDZ dst) = pprSizeReg SLIT("gldz") F64 dst
1523 pprGInstr (GLD1 dst) = pprSizeReg SLIT("gld1") F64 dst
1525 pprGInstr (GFTOI src dst) = pprSizeSizeRegReg SLIT("gftoi") F32 I32 src dst
1526 pprGInstr (GDTOI src dst) = pprSizeSizeRegReg SLIT("gdtoi") F64 I32 src dst
1528 pprGInstr (GITOF src dst) = pprSizeSizeRegReg SLIT("gitof") I32 F32 src dst
1529 pprGInstr (GITOD src dst) = pprSizeSizeRegReg SLIT("gitod") I32 F64 src dst
1531 pprGInstr (GCMP co src dst) = pprCondRegReg SLIT("gcmp_") F64 co src dst
1532 pprGInstr (GABS sz src dst) = pprSizeRegReg SLIT("gabs") sz src dst
1533 pprGInstr (GNEG sz src dst) = pprSizeRegReg SLIT("gneg") sz src dst
1534 pprGInstr (GSQRT sz src dst) = pprSizeRegReg SLIT("gsqrt") sz src dst
1535 pprGInstr (GSIN sz src dst) = pprSizeRegReg SLIT("gsin") sz src dst
1536 pprGInstr (GCOS sz src dst) = pprSizeRegReg SLIT("gcos") sz src dst
1537 pprGInstr (GTAN sz src dst) = pprSizeRegReg SLIT("gtan") sz src dst
1539 pprGInstr (GADD sz src1 src2 dst) = pprSizeRegRegReg SLIT("gadd") sz src1 src2 dst
1540 pprGInstr (GSUB sz src1 src2 dst) = pprSizeRegRegReg SLIT("gsub") sz src1 src2 dst
1541 pprGInstr (GMUL sz src1 src2 dst) = pprSizeRegRegReg SLIT("gmul") sz src1 src2 dst
1542 pprGInstr (GDIV sz src1 src2 dst) = pprSizeRegRegReg SLIT("gdiv") sz src1 src2 dst
1545 #if i386_TARGET_ARCH || x86_64_TARGET_ARCH
1547 -- Emit code to make hi_reg:lo_reg be the 64-bit product of hi_reg and lo_reg
1548 pprInstr_imul64 hi_reg lo_reg
1549 = let fakeInsn = text "imul64" <+> pp_hi_reg <> comma <+> pp_lo_reg
1550 pp_hi_reg = pprReg wordRep hi_reg
1551 pp_lo_reg = pprReg wordRep lo_reg
1554 text "\t# BEGIN " <> fakeInsn,
1555 text "\tpushl" <+> pp_hi_reg <> text" ; pushl" <+> pp_lo_reg,
1556 text "\tpushl %eax ; pushl %edx",
1557 text "\tmovl 12(%esp), %eax ; imull 8(%esp)",
1558 text "\tmovl %edx, 12(%esp) ; movl %eax, 8(%esp)",
1559 text "\tpopl %edx ; popl %eax",
1560 text "\tpopl" <+> pp_lo_reg <> text " ; popl" <+> pp_hi_reg,
1561 text "\t# END " <> fakeInsn
1563 -- Continue with I386-only printing bits and bobs:
1565 pprDollImm :: Imm -> Doc
1567 pprDollImm i = ptext SLIT("$") <> pprImm i
1569 pprOperand :: MachRep -> Operand -> Doc
1570 pprOperand s (OpReg r) = pprReg s r
1571 pprOperand s (OpImm i) = pprDollImm i
1572 pprOperand s (OpAddr ea) = pprAddr ea
1574 pprMnemonic_ :: LitString -> Doc
1576 char '\t' <> ptext name <> space
1578 pprMnemonic :: LitString -> MachRep -> Doc
1579 pprMnemonic name size =
1580 char '\t' <> ptext name <> pprSize size <> space
1582 pprSizeImmOp :: LitString -> MachRep -> Imm -> Operand -> Doc
1583 pprSizeImmOp name size imm op1
1585 pprMnemonic name size,
1592 pprSizeOp :: LitString -> MachRep -> Operand -> Doc
1593 pprSizeOp name size op1
1595 pprMnemonic name size,
1599 pprSizeOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1600 pprSizeOpOp name size op1 op2
1602 pprMnemonic name size,
1603 pprOperand size op1,
1608 pprOpOp :: LitString -> MachRep -> Operand -> Operand -> Doc
1609 pprOpOp name size op1 op2
1612 pprOperand size op1,
1617 pprSizeReg :: LitString -> MachRep -> Reg -> Doc
1618 pprSizeReg name size reg1
1620 pprMnemonic name size,
1624 pprSizeRegReg :: LitString -> MachRep -> Reg -> Reg -> Doc
1625 pprSizeRegReg name size reg1 reg2
1627 pprMnemonic name size,
1633 pprRegReg :: LitString -> Reg -> Reg -> Doc
1634 pprRegReg name reg1 reg2
1637 pprReg wordRep reg1,
1642 pprOpReg :: LitString -> Operand -> Reg -> Doc
1643 pprOpReg name op1 reg2
1646 pprOperand wordRep op1,
1651 pprCondRegReg :: LitString -> MachRep -> Cond -> Reg -> Reg -> Doc
1652 pprCondRegReg name size cond reg1 reg2
1663 pprSizeSizeRegReg :: LitString -> MachRep -> MachRep -> Reg -> Reg -> Doc
1664 pprSizeSizeRegReg name size1 size2 reg1 reg2
1677 pprSizeRegRegReg :: LitString -> MachRep -> Reg -> Reg -> Reg -> Doc
1678 pprSizeRegRegReg name size reg1 reg2 reg3
1680 pprMnemonic name size,
1688 pprSizeAddrReg :: LitString -> MachRep -> AddrMode -> Reg -> Doc
1689 pprSizeAddrReg name size op dst
1691 pprMnemonic name size,
1697 pprSizeRegAddr :: LitString -> MachRep -> Reg -> AddrMode -> Doc
1698 pprSizeRegAddr name size src op
1700 pprMnemonic name size,
1706 pprShift :: LitString -> MachRep -> Operand -> Operand -> Doc
1707 pprShift name size src dest
1709 pprMnemonic name size,
1710 pprOperand I8 src, -- src is 8-bit sized
1712 pprOperand size dest
1715 pprSizeOpOpCoerce :: LitString -> MachRep -> MachRep -> Operand -> Operand -> Doc
1716 pprSizeOpOpCoerce name size1 size2 op1 op2
1717 = hcat [ char '\t', ptext name, pprSize size1, pprSize size2, space,
1718 pprOperand size1 op1,
1720 pprOperand size2 op2
1723 pprCondInstr :: LitString -> Cond -> Doc -> Doc
1724 pprCondInstr name cond arg
1725 = hcat [ char '\t', ptext name, pprCond cond, space, arg]
1727 #endif /* i386_TARGET_ARCH */
1730 -- ------------------------------------------------------------------------------- pprInstr for a SPARC
1732 #if sparc_TARGET_ARCH
1734 -- a clumsy hack for now, to handle possible double alignment problems
1736 -- even clumsier, to allow for RegReg regs that show when doing indexed
1737 -- reads (bytearrays).
1740 -- Translate to the following:
1743 -- ld [g1+4],%f(n+1)
1744 -- sub g1,g2,g1 -- to restore g1
1745 pprInstr (LD DF (AddrRegReg g1 g2) reg)
1747 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1748 hcat [pp_ld_lbracket, pprReg g1, pp_rbracket_comma, pprReg reg],
1749 hcat [pp_ld_lbracket, pprReg g1, ptext SLIT("+4]"), comma, pprReg (fPair reg)],
1750 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1755 -- ld [addr+4],%f(n+1)
1756 pprInstr (LD DF addr reg) | isJust off_addr
1758 hcat [pp_ld_lbracket, pprAddr addr, pp_rbracket_comma, pprReg reg],
1759 hcat [pp_ld_lbracket, pprAddr addr2, pp_rbracket_comma,pprReg (fPair reg)]
1762 off_addr = addrOffset addr 4
1763 addr2 = case off_addr of Just x -> x
1766 pprInstr (LD size addr reg)
1777 -- The same clumsy hack as above
1779 -- Translate to the following:
1782 -- st %f(n+1),[g1+4]
1783 -- sub g1,g2,g1 -- to restore g1
1784 pprInstr (ST DF reg (AddrRegReg g1 g2))
1786 hcat [ptext SLIT("\tadd\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1],
1787 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1789 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1790 pprReg g1, ptext SLIT("+4]")],
1791 hcat [ptext SLIT("\tsub\t"), pprReg g1,comma,pprReg g2,comma,pprReg g1]
1796 -- st %f(n+1),[addr+4]
1797 pprInstr (ST DF reg addr) | isJust off_addr
1799 hcat [ptext SLIT("\tst\t"), pprReg reg, pp_comma_lbracket,
1800 pprAddr addr, rbrack],
1801 hcat [ptext SLIT("\tst\t"), pprReg (fPair reg), pp_comma_lbracket,
1802 pprAddr addr2, rbrack]
1805 off_addr = addrOffset addr 4
1806 addr2 = case off_addr of Just x -> x
1808 -- no distinction is made between signed and unsigned bytes on stores for the
1809 -- Sparc opcodes (at least I cannot see any, and gas is nagging me --SOF),
1810 -- so we call a special-purpose pprSize for ST..
1812 pprInstr (ST size reg addr)
1823 pprInstr (ADD x cc reg1 ri reg2)
1824 | not x && not cc && riZero ri
1825 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1827 = pprRegRIReg (if x then SLIT("addx") else SLIT("add")) cc reg1 ri reg2
1829 pprInstr (SUB x cc reg1 ri reg2)
1830 | not x && cc && reg2 == g0
1831 = hcat [ ptext SLIT("\tcmp\t"), pprReg reg1, comma, pprRI ri ]
1832 | not x && not cc && riZero ri
1833 = hcat [ ptext SLIT("\tmov\t"), pprReg reg1, comma, pprReg reg2 ]
1835 = pprRegRIReg (if x then SLIT("subx") else SLIT("sub")) cc reg1 ri reg2
1837 pprInstr (AND b reg1 ri reg2) = pprRegRIReg SLIT("and") b reg1 ri reg2
1838 pprInstr (ANDN b reg1 ri reg2) = pprRegRIReg SLIT("andn") b reg1 ri reg2
1840 pprInstr (OR b reg1 ri reg2)
1841 | not b && reg1 == g0
1842 = let doit = hcat [ ptext SLIT("\tmov\t"), pprRI ri, comma, pprReg reg2 ]
1844 RIReg rrr | rrr == reg2 -> empty
1847 = pprRegRIReg SLIT("or") b reg1 ri reg2
1849 pprInstr (ORN b reg1 ri reg2) = pprRegRIReg SLIT("orn") b reg1 ri reg2
1851 pprInstr (XOR b reg1 ri reg2) = pprRegRIReg SLIT("xor") b reg1 ri reg2
1852 pprInstr (XNOR b reg1 ri reg2) = pprRegRIReg SLIT("xnor") b reg1 ri reg2
1854 pprInstr (SLL reg1 ri reg2) = pprRegRIReg SLIT("sll") False reg1 ri reg2
1855 pprInstr (SRL reg1 ri reg2) = pprRegRIReg SLIT("srl") False reg1 ri reg2
1856 pprInstr (SRA reg1 ri reg2) = pprRegRIReg SLIT("sra") False reg1 ri reg2
1858 pprInstr (RDY rd) = ptext SLIT("\trd\t%y,") <> pprReg rd
1859 pprInstr (SMUL b reg1 ri reg2) = pprRegRIReg SLIT("smul") b reg1 ri reg2
1860 pprInstr (UMUL b reg1 ri reg2) = pprRegRIReg SLIT("umul") b reg1 ri reg2
1862 pprInstr (SETHI imm reg)
1864 ptext SLIT("\tsethi\t"),
1870 pprInstr NOP = ptext SLIT("\tnop")
1872 pprInstr (FABS F reg1 reg2) = pprSizeRegReg SLIT("fabs") F reg1 reg2
1873 pprInstr (FABS DF reg1 reg2)
1874 = (<>) (pprSizeRegReg SLIT("fabs") F reg1 reg2)
1875 (if (reg1 == reg2) then empty
1876 else (<>) (char '\n')
1877 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1879 pprInstr (FADD size reg1 reg2 reg3)
1880 = pprSizeRegRegReg SLIT("fadd") size reg1 reg2 reg3
1881 pprInstr (FCMP e size reg1 reg2)
1882 = pprSizeRegReg (if e then SLIT("fcmpe") else SLIT("fcmp")) size reg1 reg2
1883 pprInstr (FDIV size reg1 reg2 reg3)
1884 = pprSizeRegRegReg SLIT("fdiv") size reg1 reg2 reg3
1886 pprInstr (FMOV F reg1 reg2) = pprSizeRegReg SLIT("fmov") F reg1 reg2
1887 pprInstr (FMOV DF reg1 reg2)
1888 = (<>) (pprSizeRegReg SLIT("fmov") F reg1 reg2)
1889 (if (reg1 == reg2) then empty
1890 else (<>) (char '\n')
1891 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1893 pprInstr (FMUL size reg1 reg2 reg3)
1894 = pprSizeRegRegReg SLIT("fmul") size reg1 reg2 reg3
1896 pprInstr (FNEG F reg1 reg2) = pprSizeRegReg SLIT("fneg") F reg1 reg2
1897 pprInstr (FNEG DF reg1 reg2)
1898 = (<>) (pprSizeRegReg SLIT("fneg") F reg1 reg2)
1899 (if (reg1 == reg2) then empty
1900 else (<>) (char '\n')
1901 (pprSizeRegReg SLIT("fmov") F (fPair reg1) (fPair reg2)))
1903 pprInstr (FSQRT size reg1 reg2) = pprSizeRegReg SLIT("fsqrt") size reg1 reg2
1904 pprInstr (FSUB size reg1 reg2 reg3) = pprSizeRegRegReg SLIT("fsub") size reg1 reg2 reg3
1905 pprInstr (FxTOy size1 size2 reg1 reg2)
1918 pprReg reg1, comma, pprReg reg2
1922 pprInstr (BI cond b lab)
1924 ptext SLIT("\tb"), pprCond cond,
1925 if b then pp_comma_a else empty,
1930 pprInstr (BF cond b lab)
1932 ptext SLIT("\tfb"), pprCond cond,
1933 if b then pp_comma_a else empty,
1938 pprInstr (JMP dsts addr) = (<>) (ptext SLIT("\tjmp\t")) (pprAddr addr)
1940 pprInstr (CALL (Left imm) n _)
1941 = hcat [ ptext SLIT("\tcall\t"), pprImm imm, comma, int n ]
1942 pprInstr (CALL (Right reg) n _)
1943 = hcat [ ptext SLIT("\tcall\t"), pprReg reg, comma, int n ]
1946 Continue with SPARC-only printing bits and bobs:
1949 pprRI (RIReg r) = pprReg r
1950 pprRI (RIImm r) = pprImm r
1952 pprSizeRegReg :: LitString -> Size -> Reg -> Reg -> Doc
1953 pprSizeRegReg name size reg1 reg2
1958 F -> ptext SLIT("s\t")
1959 DF -> ptext SLIT("d\t")),
1965 pprSizeRegRegReg :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
1966 pprSizeRegRegReg name size reg1 reg2 reg3
1971 F -> ptext SLIT("s\t")
1972 DF -> ptext SLIT("d\t")),
1980 pprRegRIReg :: LitString -> Bool -> Reg -> RI -> Reg -> Doc
1981 pprRegRIReg name b reg1 ri reg2
1985 if b then ptext SLIT("cc\t") else char '\t',
1993 pprRIReg :: LitString -> Bool -> RI -> Reg -> Doc
1994 pprRIReg name b ri reg1
1998 if b then ptext SLIT("cc\t") else char '\t',
2004 pp_ld_lbracket = ptext SLIT("\tld\t[")
2005 pp_rbracket_comma = text "],"
2006 pp_comma_lbracket = text ",["
2007 pp_comma_a = text ",a"
2009 #endif /* sparc_TARGET_ARCH */
2012 -- -----------------------------------------------------------------------------
2013 -- pprInstr for PowerPC
2015 #if powerpc_TARGET_ARCH
2016 pprInstr (LD sz reg addr) = hcat [
2025 case addr of AddrRegImm _ _ -> empty
2026 AddrRegReg _ _ -> char 'x',
2032 pprInstr (LA sz reg addr) = hcat [
2041 case addr of AddrRegImm _ _ -> empty
2042 AddrRegReg _ _ -> char 'x',
2048 pprInstr (ST sz reg addr) = hcat [
2052 case addr of AddrRegImm _ _ -> empty
2053 AddrRegReg _ _ -> char 'x',
2059 pprInstr (STU sz reg addr) = hcat [
2064 case addr of AddrRegImm _ _ -> empty
2065 AddrRegReg _ _ -> char 'x',
2070 pprInstr (LIS reg imm) = hcat [
2078 pprInstr (LI reg imm) = hcat [
2086 pprInstr (MR reg1 reg2)
2087 | reg1 == reg2 = empty
2088 | otherwise = hcat [
2090 case regClass reg1 of
2091 RcInteger -> ptext SLIT("mr")
2092 _ -> ptext SLIT("fmr"),
2098 pprInstr (CMP sz reg ri) = hcat [
2114 pprInstr (CMPL sz reg ri) = hcat [
2130 pprInstr (BCC cond (BlockId id)) = hcat [
2137 where lbl = mkAsmTempLabel id
2139 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
2146 pprInstr (MTCTR reg) = hcat [
2148 ptext SLIT("mtctr"),
2152 pprInstr (BCTR _) = hcat [
2156 pprInstr (BL lbl _) = hcat [
2157 ptext SLIT("\tbl\t"),
2160 pprInstr (BCTRL _) = hcat [
2164 pprInstr (ADD reg1 reg2 ri) = pprLogic SLIT("add") reg1 reg2 ri
2165 pprInstr (ADDIS reg1 reg2 imm) = hcat [
2167 ptext SLIT("addis"),
2176 pprInstr (ADDC reg1 reg2 reg3) = pprLogic SLIT("addc") reg1 reg2 (RIReg reg3)
2177 pprInstr (ADDE reg1 reg2 reg3) = pprLogic SLIT("adde") reg1 reg2 (RIReg reg3)
2178 pprInstr (SUBF reg1 reg2 reg3) = pprLogic SLIT("subf") reg1 reg2 (RIReg reg3)
2179 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic SLIT("mullw") reg1 reg2 ri
2180 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic SLIT("mull") reg1 reg2 ri
2181 pprInstr (DIVW reg1 reg2 reg3) = pprLogic SLIT("divw") reg1 reg2 (RIReg reg3)
2182 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic SLIT("divwu") reg1 reg2 (RIReg reg3)
2184 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
2185 hcat [ ptext SLIT("\tmullwo\t"), pprReg reg1, ptext SLIT(", "),
2186 pprReg reg2, ptext SLIT(", "),
2188 hcat [ ptext SLIT("\tmfxer\t"), pprReg reg1 ],
2189 hcat [ ptext SLIT("\trlwinm\t"), pprReg reg1, ptext SLIT(", "),
2190 pprReg reg1, ptext SLIT(", "),
2191 ptext SLIT("2, 31, 31") ]
2194 -- for some reason, "andi" doesn't exist.
2195 -- we'll use "andi." instead.
2196 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
2198 ptext SLIT("andi."),
2206 pprInstr (AND reg1 reg2 ri) = pprLogic SLIT("and") reg1 reg2 ri
2208 pprInstr (OR reg1 reg2 ri) = pprLogic SLIT("or") reg1 reg2 ri
2209 pprInstr (XOR reg1 reg2 ri) = pprLogic SLIT("xor") reg1 reg2 ri
2211 pprInstr (XORIS reg1 reg2 imm) = hcat [
2213 ptext SLIT("xoris"),
2222 pprInstr (EXTS sz reg1 reg2) = hcat [
2232 pprInstr (NEG reg1 reg2) = pprUnary SLIT("neg") reg1 reg2
2233 pprInstr (NOT reg1 reg2) = pprUnary SLIT("not") reg1 reg2
2235 pprInstr (SLW reg1 reg2 ri) = pprLogic SLIT("slw") reg1 reg2 (limitShiftRI ri)
2236 pprInstr (SRW reg1 reg2 ri) = pprLogic SLIT("srw") reg1 reg2 (limitShiftRI ri)
2237 pprInstr (SRAW reg1 reg2 ri) = pprLogic SLIT("sraw") reg1 reg2 (limitShiftRI ri)
2238 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
2239 ptext SLIT("\trlwinm\t"),
2251 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF SLIT("fadd") sz reg1 reg2 reg3
2252 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF SLIT("fsub") sz reg1 reg2 reg3
2253 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF SLIT("fmul") sz reg1 reg2 reg3
2254 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF SLIT("fdiv") sz reg1 reg2 reg3
2255 pprInstr (FNEG reg1 reg2) = pprUnary SLIT("fneg") reg1 reg2
2257 pprInstr (FCMP reg1 reg2) = hcat [
2259 ptext SLIT("fcmpu\tcr0, "),
2260 -- Note: we're using fcmpu, not fcmpo
2261 -- The difference is with fcmpo, compare with NaN is an invalid operation.
2262 -- We don't handle invalid fp ops, so we don't care
2268 pprInstr (FCTIWZ reg1 reg2) = pprUnary SLIT("fctiwz") reg1 reg2
2269 pprInstr (FRSP reg1 reg2) = pprUnary SLIT("frsp") reg1 reg2
2271 pprInstr (CRNOR dst src1 src2) = hcat [
2272 ptext SLIT("\tcrnor\t"),
2280 pprInstr (MFCR reg) = hcat [
2287 pprInstr (MFLR reg) = hcat [
2294 pprInstr (FETCHPC reg) = vcat [
2295 ptext SLIT("\tbcl\t20,31,1f"),
2296 hcat [ ptext SLIT("1:\tmflr\t"), pprReg reg ]
2299 pprInstr _ = panic "pprInstr (ppc)"
2301 pprLogic op reg1 reg2 ri = hcat [
2306 RIImm _ -> char 'i',
2315 pprUnary op reg1 reg2 = hcat [
2324 pprBinaryF op sz reg1 reg2 reg3 = hcat [
2337 pprRI (RIReg r) = pprReg r
2338 pprRI (RIImm r) = pprImm r
2340 pprFSize F64 = empty
2341 pprFSize F32 = char 's'
2343 -- limit immediate argument for shift instruction to range 0..32
2344 -- (yes, the maximum is really 32, not 31)
2345 limitShiftRI :: RI -> RI
2346 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
2349 #endif /* powerpc_TARGET_ARCH */
2352 -- -----------------------------------------------------------------------------
2353 -- Converting floating-point literals to integrals for printing
2355 #if __GLASGOW_HASKELL__ >= 504
2356 newFloatArray :: (Int,Int) -> ST s (STUArray s Int Float)
2357 newFloatArray = newArray_
2359 newDoubleArray :: (Int,Int) -> ST s (STUArray s Int Double)
2360 newDoubleArray = newArray_
2362 castFloatToCharArray :: STUArray s Int Float -> ST s (STUArray s Int Word8)
2363 castFloatToCharArray = castSTUArray
2365 castDoubleToCharArray :: STUArray s Int Double -> ST s (STUArray s Int Word8)
2366 castDoubleToCharArray = castSTUArray
2368 writeFloatArray :: STUArray s Int Float -> Int -> Float -> ST s ()
2369 writeFloatArray = writeArray
2371 writeDoubleArray :: STUArray s Int Double -> Int -> Double -> ST s ()
2372 writeDoubleArray = writeArray
2374 readCharArray :: STUArray s Int Word8 -> Int -> ST s Char
2375 readCharArray arr i = do
2376 w <- readArray arr i
2377 return $! (chr (fromIntegral w))
2381 castFloatToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2382 castFloatToCharArray = return
2384 castDoubleToCharArray :: MutableByteArray s t -> ST s (MutableByteArray s t)
2387 castDoubleToCharArray = return
2391 -- floatToBytes and doubleToBytes convert to the host's byte
2392 -- order. Providing that we're not cross-compiling for a
2393 -- target with the opposite endianness, this should work ok
2396 -- ToDo: this stuff is very similar to the shenanigans in PprAbs,
2397 -- could they be merged?
2399 floatToBytes :: Float -> [Int]
2402 arr <- newFloatArray ((0::Int),3)
2403 writeFloatArray arr 0 f
2404 arr <- castFloatToCharArray arr
2405 i0 <- readCharArray arr 0
2406 i1 <- readCharArray arr 1
2407 i2 <- readCharArray arr 2
2408 i3 <- readCharArray arr 3
2409 return (map ord [i0,i1,i2,i3])
2412 doubleToBytes :: Double -> [Int]
2415 arr <- newDoubleArray ((0::Int),7)
2416 writeDoubleArray arr 0 d
2417 arr <- castDoubleToCharArray arr
2418 i0 <- readCharArray arr 0
2419 i1 <- readCharArray arr 1
2420 i2 <- readCharArray arr 2
2421 i3 <- readCharArray arr 3
2422 i4 <- readCharArray arr 4
2423 i5 <- readCharArray arr 5
2424 i6 <- readCharArray arr 6
2425 i7 <- readCharArray arr 7
2426 return (map ord [i0,i1,i2,i3,i4,i5,i6,i7])