Follow vreg/hreg patch in PPC NCG
[ghc.git] / compiler / nativeGen / PPC / Ppr.hs
1 -----------------------------------------------------------------------------
2 --
3 -- Pretty-printing assembly language
4 --
5 -- (c) The University of Glasgow 1993-2005
6 --
7 -----------------------------------------------------------------------------
8
9 module PPC.Ppr (
10 pprNatCmmTop,
11 pprBasicBlock,
12 pprSectionHeader,
13 pprData,
14 pprInstr,
15 pprUserReg,
16 pprSize,
17 pprImm,
18 pprDataItem,
19 )
20
21 where
22
23 #include "nativeGen/NCG.h"
24 #include "HsVersions.h"
25
26 import PPC.Regs
27 import PPC.Instr
28 import PPC.Cond
29 import PprBase
30 import Instruction
31 import Size
32 import Reg
33 import RegClass
34 import TargetReg
35
36 import BlockId
37 import Cmm
38
39 import CLabel
40
41 import Unique ( pprUnique )
42 import Pretty
43 import FastString
44 import qualified Outputable
45 import Outputable ( Outputable, panic )
46
47 import Data.Word
48 import Data.Bits
49
50
51 -- -----------------------------------------------------------------------------
52 -- Printing this stuff out
53
54 pprNatCmmTop :: NatCmmTop Instr -> Doc
55 pprNatCmmTop (CmmData section dats) =
56 pprSectionHeader section $$ vcat (map pprData dats)
57
58 -- special case for split markers:
59 pprNatCmmTop (CmmProc [] lbl _ (ListGraph [])) = pprLabel lbl
60
61 pprNatCmmTop (CmmProc info lbl _ (ListGraph blocks)) =
62 pprSectionHeader Text $$
63 (if null info then -- blocks guaranteed not null, so label needed
64 pprLabel lbl
65 else
66 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
67 pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
68 <> char ':' $$
69 #endif
70 vcat (map pprData info) $$
71 pprLabel (entryLblToInfoLbl lbl)
72 ) $$
73 vcat (map pprBasicBlock blocks)
74 -- above: Even the first block gets a label, because with branch-chain
75 -- elimination, it might be the target of a goto.
76 #if HAVE_SUBSECTIONS_VIA_SYMBOLS
77 -- If we are using the .subsections_via_symbols directive
78 -- (available on recent versions of Darwin),
79 -- we have to make sure that there is some kind of reference
80 -- from the entry code to a label on the _top_ of of the info table,
81 -- so that the linker will not think it is unreferenced and dead-strip
82 -- it. That's why the label is called a DeadStripPreventer (_dsp).
83 $$ if not (null info)
84 then text "\t.long "
85 <+> pprCLabel_asm (entryLblToInfoLbl lbl)
86 <+> char '-'
87 <+> pprCLabel_asm (mkDeadStripPreventer $ entryLblToInfoLbl lbl)
88 else empty
89 #endif
90
91
92 pprBasicBlock :: NatBasicBlock Instr -> Doc
93 pprBasicBlock (BasicBlock (BlockId id) instrs) =
94 pprLabel (mkAsmTempLabel id) $$
95 vcat (map pprInstr instrs)
96
97
98 pprData :: CmmStatic -> Doc
99 pprData (CmmAlign bytes) = pprAlign bytes
100 pprData (CmmDataLabel lbl) = pprLabel lbl
101 pprData (CmmString str) = pprASCII str
102
103 #if darwin_TARGET_OS
104 pprData (CmmUninitialised bytes) = ptext (sLit ".space ") <> int bytes
105 #else
106 pprData (CmmUninitialised bytes) = ptext (sLit ".skip ") <> int bytes
107 #endif
108
109 pprData (CmmStaticLit lit) = pprDataItem lit
110
111 pprGloblDecl :: CLabel -> Doc
112 pprGloblDecl lbl
113 | not (externallyVisibleCLabel lbl) = empty
114 | otherwise = ptext IF_ARCH_sparc((sLit ".global "),
115 (sLit ".globl ")) <>
116 pprCLabel_asm lbl
117
118 pprTypeAndSizeDecl :: CLabel -> Doc
119 #if linux_TARGET_OS
120 pprTypeAndSizeDecl lbl
121 | not (externallyVisibleCLabel lbl) = empty
122 | otherwise = ptext (sLit ".type ") <>
123 pprCLabel_asm lbl <> ptext (sLit ", @object")
124 #else
125 pprTypeAndSizeDecl _
126 = empty
127 #endif
128
129 pprLabel :: CLabel -> Doc
130 pprLabel lbl = pprGloblDecl lbl $$ pprTypeAndSizeDecl lbl $$ (pprCLabel_asm lbl <> char ':')
131
132
133 pprASCII :: [Word8] -> Doc
134 pprASCII str
135 = vcat (map do1 str) $$ do1 0
136 where
137 do1 :: Word8 -> Doc
138 do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
139
140 pprAlign :: Int -> Doc
141 pprAlign bytes =
142 ptext (sLit ".align ") <> int pow2
143 where
144 pow2 = log2 bytes
145
146 log2 :: Int -> Int -- cache the common ones
147 log2 1 = 0
148 log2 2 = 1
149 log2 4 = 2
150 log2 8 = 3
151 log2 n = 1 + log2 (n `quot` 2)
152
153
154 -- -----------------------------------------------------------------------------
155 -- pprInstr: print an 'Instr'
156
157 instance Outputable Instr where
158 ppr instr = Outputable.docToSDoc $ pprInstr instr
159
160
161 pprUserReg :: Reg -> Doc
162 pprUserReg = pprReg
163
164 pprReg :: Reg -> Doc
165
166 pprReg r
167 = case r of
168 RegReal (RealRegSingle i) -> ppr_reg_no i
169 RegReal (RealRegPair{}) -> panic "PPC.pprReg: no reg pairs on this arch"
170 RegVirtual (VirtualRegI u) -> text "%vI_" <> asmSDoc (pprUnique u)
171 RegVirtual (VirtualRegHi u) -> text "%vHi_" <> asmSDoc (pprUnique u)
172 RegVirtual (VirtualRegF u) -> text "%vF_" <> asmSDoc (pprUnique u)
173 RegVirtual (VirtualRegD u) -> text "%vD_" <> asmSDoc (pprUnique u)
174 where
175 #if darwin_TARGET_OS
176 ppr_reg_no :: Int -> Doc
177 ppr_reg_no i = ptext
178 (case i of {
179 0 -> sLit "r0"; 1 -> sLit "r1";
180 2 -> sLit "r2"; 3 -> sLit "r3";
181 4 -> sLit "r4"; 5 -> sLit "r5";
182 6 -> sLit "r6"; 7 -> sLit "r7";
183 8 -> sLit "r8"; 9 -> sLit "r9";
184 10 -> sLit "r10"; 11 -> sLit "r11";
185 12 -> sLit "r12"; 13 -> sLit "r13";
186 14 -> sLit "r14"; 15 -> sLit "r15";
187 16 -> sLit "r16"; 17 -> sLit "r17";
188 18 -> sLit "r18"; 19 -> sLit "r19";
189 20 -> sLit "r20"; 21 -> sLit "r21";
190 22 -> sLit "r22"; 23 -> sLit "r23";
191 24 -> sLit "r24"; 25 -> sLit "r25";
192 26 -> sLit "r26"; 27 -> sLit "r27";
193 28 -> sLit "r28"; 29 -> sLit "r29";
194 30 -> sLit "r30"; 31 -> sLit "r31";
195 32 -> sLit "f0"; 33 -> sLit "f1";
196 34 -> sLit "f2"; 35 -> sLit "f3";
197 36 -> sLit "f4"; 37 -> sLit "f5";
198 38 -> sLit "f6"; 39 -> sLit "f7";
199 40 -> sLit "f8"; 41 -> sLit "f9";
200 42 -> sLit "f10"; 43 -> sLit "f11";
201 44 -> sLit "f12"; 45 -> sLit "f13";
202 46 -> sLit "f14"; 47 -> sLit "f15";
203 48 -> sLit "f16"; 49 -> sLit "f17";
204 50 -> sLit "f18"; 51 -> sLit "f19";
205 52 -> sLit "f20"; 53 -> sLit "f21";
206 54 -> sLit "f22"; 55 -> sLit "f23";
207 56 -> sLit "f24"; 57 -> sLit "f25";
208 58 -> sLit "f26"; 59 -> sLit "f27";
209 60 -> sLit "f28"; 61 -> sLit "f29";
210 62 -> sLit "f30"; 63 -> sLit "f31";
211 _ -> sLit "very naughty powerpc register"
212 })
213 #else
214 ppr_reg_no :: Int -> Doc
215 ppr_reg_no i | i <= 31 = int i -- GPRs
216 | i <= 63 = int (i-32) -- FPRs
217 | otherwise = ptext (sLit "very naughty powerpc register")
218 #endif
219
220
221
222 pprSize :: Size -> Doc
223 pprSize x
224 = ptext (case x of
225 II8 -> sLit "b"
226 II16 -> sLit "h"
227 II32 -> sLit "w"
228 FF32 -> sLit "fs"
229 FF64 -> sLit "fd"
230 _ -> panic "PPC.Ppr.pprSize: no match")
231
232
233 pprCond :: Cond -> Doc
234 pprCond c
235 = ptext (case c of {
236 ALWAYS -> sLit "";
237 EQQ -> sLit "eq"; NE -> sLit "ne";
238 LTT -> sLit "lt"; GE -> sLit "ge";
239 GTT -> sLit "gt"; LE -> sLit "le";
240 LU -> sLit "lt"; GEU -> sLit "ge";
241 GU -> sLit "gt"; LEU -> sLit "le"; })
242
243
244 pprImm :: Imm -> Doc
245
246 pprImm (ImmInt i) = int i
247 pprImm (ImmInteger i) = integer i
248 pprImm (ImmCLbl l) = pprCLabel_asm l
249 pprImm (ImmIndex l i) = pprCLabel_asm l <> char '+' <> int i
250 pprImm (ImmLit s) = s
251
252 pprImm (ImmFloat _) = ptext (sLit "naughty float immediate")
253 pprImm (ImmDouble _) = ptext (sLit "naughty double immediate")
254
255 pprImm (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
256 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
257 <> lparen <> pprImm b <> rparen
258
259 #if darwin_TARGET_OS
260 pprImm (LO i)
261 = hcat [ pp_lo, pprImm i, rparen ]
262 where
263 pp_lo = text "lo16("
264
265 pprImm (HI i)
266 = hcat [ pp_hi, pprImm i, rparen ]
267 where
268 pp_hi = text "hi16("
269
270 pprImm (HA i)
271 = hcat [ pp_ha, pprImm i, rparen ]
272 where
273 pp_ha = text "ha16("
274
275 #else
276 pprImm (LO i)
277 = pprImm i <> text "@l"
278
279 pprImm (HI i)
280 = pprImm i <> text "@h"
281
282 pprImm (HA i)
283 = pprImm i <> text "@ha"
284 #endif
285
286
287
288 pprAddr :: AddrMode -> Doc
289 pprAddr (AddrRegReg r1 r2)
290 = pprReg r1 <+> ptext (sLit ", ") <+> pprReg r2
291
292 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
293 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
294 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
295
296
297 pprSectionHeader :: Section -> Doc
298 #if darwin_TARGET_OS
299 pprSectionHeader seg
300 = case seg of
301 Text -> ptext (sLit ".text\n.align 2")
302 Data -> ptext (sLit ".data\n.align 2")
303 ReadOnlyData -> ptext (sLit ".const\n.align 2")
304 RelocatableReadOnlyData -> ptext (sLit ".const_data\n.align 2")
305 UninitialisedData -> ptext (sLit ".const_data\n.align 2")
306 ReadOnlyData16 -> ptext (sLit ".const\n.align 4")
307 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
308
309 #else
310 pprSectionHeader seg
311 = case seg of
312 Text -> ptext (sLit ".text\n.align 2")
313 Data -> ptext (sLit ".data\n.align 2")
314 ReadOnlyData -> ptext (sLit ".section .rodata\n\t.align 2")
315 RelocatableReadOnlyData -> ptext (sLit ".data\n\t.align 2")
316 UninitialisedData -> ptext (sLit ".section .bss\n\t.align 2")
317 ReadOnlyData16 -> ptext (sLit ".section .rodata\n\t.align 4")
318 OtherSection _ -> panic "PprMach.pprSectionHeader: unknown section"
319
320 #endif
321
322
323 pprDataItem :: CmmLit -> Doc
324 pprDataItem lit
325 = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
326 where
327 imm = litToImm lit
328
329 ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
330
331 ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
332
333 ppr_item FF32 (CmmFloat r _)
334 = let bs = floatToBytes (fromRational r)
335 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
336
337 ppr_item FF64 (CmmFloat r _)
338 = let bs = doubleToBytes (fromRational r)
339 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
340
341 ppr_item II16 _ = [ptext (sLit "\t.short\t") <> pprImm imm]
342
343 ppr_item II64 (CmmInt x _) =
344 [ptext (sLit "\t.long\t")
345 <> int (fromIntegral
346 (fromIntegral (x `shiftR` 32) :: Word32)),
347 ptext (sLit "\t.long\t")
348 <> int (fromIntegral (fromIntegral x :: Word32))]
349
350 ppr_item _ _
351 = panic "PPC.Ppr.pprDataItem: no match"
352
353
354 pprInstr :: Instr -> Doc
355
356 pprInstr (COMMENT _) = empty -- nuke 'em
357 {-
358 pprInstr (COMMENT s)
359 = IF_ARCH_alpha( ((<>) (ptext (sLit "\t# ")) (ftext s))
360 ,IF_ARCH_sparc( ((<>) (ptext (sLit "# ")) (ftext s))
361 ,IF_ARCH_i386( ((<>) (ptext (sLit "# ")) (ftext s))
362 ,IF_ARCH_x86_64( ((<>) (ptext (sLit "# ")) (ftext s))
363 ,IF_ARCH_powerpc( IF_OS_linux(
364 ((<>) (ptext (sLit "# ")) (ftext s)),
365 ((<>) (ptext (sLit "; ")) (ftext s)))
366 ,)))))
367 -}
368 pprInstr (DELTA d)
369 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
370
371 pprInstr (NEWBLOCK _)
372 = panic "PprMach.pprInstr: NEWBLOCK"
373
374 pprInstr (LDATA _ _)
375 = panic "PprMach.pprInstr: LDATA"
376
377 {-
378 pprInstr (SPILL reg slot)
379 = hcat [
380 ptext (sLit "\tSPILL"),
381 char '\t',
382 pprReg reg,
383 comma,
384 ptext (sLit "SLOT") <> parens (int slot)]
385
386 pprInstr (RELOAD slot reg)
387 = hcat [
388 ptext (sLit "\tRELOAD"),
389 char '\t',
390 ptext (sLit "SLOT") <> parens (int slot),
391 comma,
392 pprReg reg]
393 -}
394
395 pprInstr (LD sz reg addr) = hcat [
396 char '\t',
397 ptext (sLit "l"),
398 ptext (case sz of
399 II8 -> sLit "bz"
400 II16 -> sLit "hz"
401 II32 -> sLit "wz"
402 FF32 -> sLit "fs"
403 FF64 -> sLit "fd"
404 _ -> panic "PPC.Ppr.pprInstr: no match"
405 ),
406 case addr of AddrRegImm _ _ -> empty
407 AddrRegReg _ _ -> char 'x',
408 char '\t',
409 pprReg reg,
410 ptext (sLit ", "),
411 pprAddr addr
412 ]
413 pprInstr (LA sz reg addr) = hcat [
414 char '\t',
415 ptext (sLit "l"),
416 ptext (case sz of
417 II8 -> sLit "ba"
418 II16 -> sLit "ha"
419 II32 -> sLit "wa"
420 FF32 -> sLit "fs"
421 FF64 -> sLit "fd"
422 _ -> panic "PPC.Ppr.pprInstr: no match"
423 ),
424 case addr of AddrRegImm _ _ -> empty
425 AddrRegReg _ _ -> char 'x',
426 char '\t',
427 pprReg reg,
428 ptext (sLit ", "),
429 pprAddr addr
430 ]
431 pprInstr (ST sz reg addr) = hcat [
432 char '\t',
433 ptext (sLit "st"),
434 pprSize sz,
435 case addr of AddrRegImm _ _ -> empty
436 AddrRegReg _ _ -> char 'x',
437 char '\t',
438 pprReg reg,
439 ptext (sLit ", "),
440 pprAddr addr
441 ]
442 pprInstr (STU sz reg addr) = hcat [
443 char '\t',
444 ptext (sLit "st"),
445 pprSize sz,
446 ptext (sLit "u\t"),
447 case addr of AddrRegImm _ _ -> empty
448 AddrRegReg _ _ -> char 'x',
449 pprReg reg,
450 ptext (sLit ", "),
451 pprAddr addr
452 ]
453 pprInstr (LIS reg imm) = hcat [
454 char '\t',
455 ptext (sLit "lis"),
456 char '\t',
457 pprReg reg,
458 ptext (sLit ", "),
459 pprImm imm
460 ]
461 pprInstr (LI reg imm) = hcat [
462 char '\t',
463 ptext (sLit "li"),
464 char '\t',
465 pprReg reg,
466 ptext (sLit ", "),
467 pprImm imm
468 ]
469 pprInstr (MR reg1 reg2)
470 | reg1 == reg2 = empty
471 | otherwise = hcat [
472 char '\t',
473 case targetClassOfReg reg1 of
474 RcInteger -> ptext (sLit "mr")
475 _ -> ptext (sLit "fmr"),
476 char '\t',
477 pprReg reg1,
478 ptext (sLit ", "),
479 pprReg reg2
480 ]
481 pprInstr (CMP sz reg ri) = hcat [
482 char '\t',
483 op,
484 char '\t',
485 pprReg reg,
486 ptext (sLit ", "),
487 pprRI ri
488 ]
489 where
490 op = hcat [
491 ptext (sLit "cmp"),
492 pprSize sz,
493 case ri of
494 RIReg _ -> empty
495 RIImm _ -> char 'i'
496 ]
497 pprInstr (CMPL sz reg ri) = hcat [
498 char '\t',
499 op,
500 char '\t',
501 pprReg reg,
502 ptext (sLit ", "),
503 pprRI ri
504 ]
505 where
506 op = hcat [
507 ptext (sLit "cmpl"),
508 pprSize sz,
509 case ri of
510 RIReg _ -> empty
511 RIImm _ -> char 'i'
512 ]
513 pprInstr (BCC cond (BlockId id)) = hcat [
514 char '\t',
515 ptext (sLit "b"),
516 pprCond cond,
517 char '\t',
518 pprCLabel_asm lbl
519 ]
520 where lbl = mkAsmTempLabel id
521
522 pprInstr (BCCFAR cond (BlockId id)) = vcat [
523 hcat [
524 ptext (sLit "\tb"),
525 pprCond (condNegate cond),
526 ptext (sLit "\t$+8")
527 ],
528 hcat [
529 ptext (sLit "\tb\t"),
530 pprCLabel_asm lbl
531 ]
532 ]
533 where lbl = mkAsmTempLabel id
534
535 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
536 char '\t',
537 ptext (sLit "b"),
538 char '\t',
539 pprCLabel_asm lbl
540 ]
541
542 pprInstr (MTCTR reg) = hcat [
543 char '\t',
544 ptext (sLit "mtctr"),
545 char '\t',
546 pprReg reg
547 ]
548 pprInstr (BCTR _) = hcat [
549 char '\t',
550 ptext (sLit "bctr")
551 ]
552 pprInstr (BL lbl _) = hcat [
553 ptext (sLit "\tbl\t"),
554 pprCLabel_asm lbl
555 ]
556 pprInstr (BCTRL _) = hcat [
557 char '\t',
558 ptext (sLit "bctrl")
559 ]
560 pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
561 pprInstr (ADDIS reg1 reg2 imm) = hcat [
562 char '\t',
563 ptext (sLit "addis"),
564 char '\t',
565 pprReg reg1,
566 ptext (sLit ", "),
567 pprReg reg2,
568 ptext (sLit ", "),
569 pprImm imm
570 ]
571
572 pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
573 pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
574 pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
575 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
576 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
577 pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
578 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
579
580 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
581 hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
582 pprReg reg2, ptext (sLit ", "),
583 pprReg reg3 ],
584 hcat [ ptext (sLit "\tmfxer\t"), pprReg reg1 ],
585 hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
586 pprReg reg1, ptext (sLit ", "),
587 ptext (sLit "2, 31, 31") ]
588 ]
589
590 -- for some reason, "andi" doesn't exist.
591 -- we'll use "andi." instead.
592 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
593 char '\t',
594 ptext (sLit "andi."),
595 char '\t',
596 pprReg reg1,
597 ptext (sLit ", "),
598 pprReg reg2,
599 ptext (sLit ", "),
600 pprImm imm
601 ]
602 pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
603
604 pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
605 pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
606
607 pprInstr (XORIS reg1 reg2 imm) = hcat [
608 char '\t',
609 ptext (sLit "xoris"),
610 char '\t',
611 pprReg reg1,
612 ptext (sLit ", "),
613 pprReg reg2,
614 ptext (sLit ", "),
615 pprImm imm
616 ]
617
618 pprInstr (EXTS sz reg1 reg2) = hcat [
619 char '\t',
620 ptext (sLit "exts"),
621 pprSize sz,
622 char '\t',
623 pprReg reg1,
624 ptext (sLit ", "),
625 pprReg reg2
626 ]
627
628 pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
629 pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
630
631 pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
632 pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
633 pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
634 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
635 ptext (sLit "\trlwinm\t"),
636 pprReg reg1,
637 ptext (sLit ", "),
638 pprReg reg2,
639 ptext (sLit ", "),
640 int sh,
641 ptext (sLit ", "),
642 int mb,
643 ptext (sLit ", "),
644 int me
645 ]
646
647 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
648 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
649 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
650 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
651 pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
652
653 pprInstr (FCMP reg1 reg2) = hcat [
654 char '\t',
655 ptext (sLit "fcmpu\tcr0, "),
656 -- Note: we're using fcmpu, not fcmpo
657 -- The difference is with fcmpo, compare with NaN is an invalid operation.
658 -- We don't handle invalid fp ops, so we don't care
659 pprReg reg1,
660 ptext (sLit ", "),
661 pprReg reg2
662 ]
663
664 pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
665 pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
666
667 pprInstr (CRNOR dst src1 src2) = hcat [
668 ptext (sLit "\tcrnor\t"),
669 int dst,
670 ptext (sLit ", "),
671 int src1,
672 ptext (sLit ", "),
673 int src2
674 ]
675
676 pprInstr (MFCR reg) = hcat [
677 char '\t',
678 ptext (sLit "mfcr"),
679 char '\t',
680 pprReg reg
681 ]
682
683 pprInstr (MFLR reg) = hcat [
684 char '\t',
685 ptext (sLit "mflr"),
686 char '\t',
687 pprReg reg
688 ]
689
690 pprInstr (FETCHPC reg) = vcat [
691 ptext (sLit "\tbcl\t20,31,1f"),
692 hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
693 ]
694
695 pprInstr LWSYNC = ptext (sLit "\tlwsync")
696
697 -- pprInstr _ = panic "pprInstr (ppc)"
698
699
700 pprLogic :: LitString -> Reg -> Reg -> RI -> Doc
701 pprLogic op reg1 reg2 ri = hcat [
702 char '\t',
703 ptext op,
704 case ri of
705 RIReg _ -> empty
706 RIImm _ -> char 'i',
707 char '\t',
708 pprReg reg1,
709 ptext (sLit ", "),
710 pprReg reg2,
711 ptext (sLit ", "),
712 pprRI ri
713 ]
714
715
716 pprUnary :: LitString -> Reg -> Reg -> Doc
717 pprUnary op reg1 reg2 = hcat [
718 char '\t',
719 ptext op,
720 char '\t',
721 pprReg reg1,
722 ptext (sLit ", "),
723 pprReg reg2
724 ]
725
726
727 pprBinaryF :: LitString -> Size -> Reg -> Reg -> Reg -> Doc
728 pprBinaryF op sz reg1 reg2 reg3 = hcat [
729 char '\t',
730 ptext op,
731 pprFSize sz,
732 char '\t',
733 pprReg reg1,
734 ptext (sLit ", "),
735 pprReg reg2,
736 ptext (sLit ", "),
737 pprReg reg3
738 ]
739
740 pprRI :: RI -> Doc
741 pprRI (RIReg r) = pprReg r
742 pprRI (RIImm r) = pprImm r
743
744
745 pprFSize :: Size -> Doc
746 pprFSize FF64 = empty
747 pprFSize FF32 = char 's'
748 pprFSize _ = panic "PPC.Ppr.pprFSize: no match"
749
750 -- limit immediate argument for shift instruction to range 0..32
751 -- (yes, the maximum is really 32, not 31)
752 limitShiftRI :: RI -> RI
753 limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
754 limitShiftRI x = x
755