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