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