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