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