New codegen: do not split proc-points when using the 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 {-# OPTIONS_GHC -fno-warn-orphans #-}
10 module PPC.Ppr (
11 pprNatCmmDecl,
12 pprBasicBlock,
13 pprSectionHeader,
14 pprData,
15 pprInstr,
16 pprSize,
17 pprImm,
18 pprDataItem,
19 )
20
21 where
22
23 import PPC.Regs
24 import PPC.Instr
25 import PPC.Cond
26 import PprBase
27 import Instruction
28 import Size
29 import Reg
30 import RegClass
31 import TargetReg
32
33 import OldCmm
34
35 import CLabel
36
37 import Unique ( pprUnique, Uniquable(..) )
38 import Platform
39 import FastString
40 import Outputable
41
42 import Data.Word
43 import Data.Bits
44
45
46 -- -----------------------------------------------------------------------------
47 -- Printing this stuff out
48
49 pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
50 pprNatCmmDecl (CmmData section dats) =
51 pprSectionHeader section $$ pprDatas dats
52
53 pprNatCmmDecl proc@(CmmProc _ lbl (ListGraph blocks)) =
54 case topInfoTable proc of
55 Nothing ->
56 case blocks of
57 [] -> -- special case for split markers:
58 pprLabel lbl
59 blocks -> -- special case for code without info table:
60 pprSectionHeader Text $$
61 pprLabel lbl $$ -- blocks guaranteed not null, so label needed
62 vcat (map pprBasicBlock blocks)
63
64 Just (Statics info_lbl info) ->
65 sdocWithPlatform $ \platform ->
66 pprSectionHeader Text $$
67 (
68 (if platformHasSubsectionsViaSymbols platform
69 then ppr (mkDeadStripPreventer info_lbl) <> char ':'
70 else empty) $$
71 vcat (map pprData info) $$
72 pprLabel info_lbl
73 ) $$
74 vcat (map pprBasicBlock blocks) $$
75 -- above: Even the first block gets a label, because with branch-chain
76 -- elimination, it might be the target of a goto.
77 (if platformHasSubsectionsViaSymbols platform
78 then
79 -- If we are using the .subsections_via_symbols directive
80 -- (available on recent versions of Darwin),
81 -- we have to make sure that there is some kind of reference
82 -- from the entry code to a label on the _top_ of of the info table,
83 -- so that the linker will not think it is unreferenced and dead-strip
84 -- it. That's why the label is called a DeadStripPreventer (_dsp).
85 text "\t.long "
86 <+> ppr info_lbl
87 <+> char '-'
88 <+> ppr (mkDeadStripPreventer info_lbl)
89 else empty)
90
91
92 pprBasicBlock :: NatBasicBlock Instr -> SDoc
93 pprBasicBlock (BasicBlock blockid instrs) =
94 pprLabel (mkAsmTempLabel (getUnique blockid)) $$
95 vcat (map pprInstr instrs)
96
97
98
99 pprDatas :: CmmStatics -> SDoc
100 pprDatas (Statics lbl dats) = vcat (pprLabel lbl : map pprData dats)
101
102 pprData :: CmmStatic -> SDoc
103 pprData (CmmString str) = pprASCII str
104 pprData (CmmUninitialised bytes) = keyword <> int bytes
105 where keyword = sdocWithPlatform $ \platform ->
106 case platformOS platform of
107 OSDarwin -> ptext (sLit ".space ")
108 _ -> ptext (sLit ".skip ")
109 pprData (CmmStaticLit lit) = pprDataItem lit
110
111 pprGloblDecl :: CLabel -> SDoc
112 pprGloblDecl lbl
113 | not (externallyVisibleCLabel lbl) = empty
114 | otherwise = ptext (sLit ".globl ") <> ppr lbl
115
116 pprTypeAndSizeDecl :: CLabel -> SDoc
117 pprTypeAndSizeDecl lbl
118 = sdocWithPlatform $ \platform ->
119 if platformOS platform == OSLinux && externallyVisibleCLabel lbl
120 then ptext (sLit ".type ") <>
121 ppr lbl <> ptext (sLit ", @object")
122 else empty
123
124 pprLabel :: CLabel -> SDoc
125 pprLabel lbl = pprGloblDecl lbl
126 $$ pprTypeAndSizeDecl lbl
127 $$ (ppr lbl <> char ':')
128
129
130 pprASCII :: [Word8] -> SDoc
131 pprASCII str
132 = vcat (map do1 str) $$ do1 0
133 where
134 do1 :: Word8 -> SDoc
135 do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)
136
137
138 -- -----------------------------------------------------------------------------
139 -- pprInstr: print an 'Instr'
140
141 instance Outputable Instr where
142 ppr instr = pprInstr instr
143
144
145 pprReg :: Reg -> SDoc
146
147 pprReg r
148 = case r of
149 RegReal (RealRegSingle i) -> ppr_reg_no i
150 RegReal (RealRegPair{}) -> panic "PPC.pprReg: no reg pairs on this arch"
151 RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUnique u
152 RegVirtual (VirtualRegHi u) -> text "%vHi_" <> pprUnique u
153 RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUnique u
154 RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUnique u
155 RegVirtual (VirtualRegSSE u) -> text "%vSSE_" <> pprUnique u
156 where
157 ppr_reg_no :: Int -> SDoc
158 ppr_reg_no i =
159 sdocWithPlatform $ \platform ->
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 -> SDoc
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 -> SDoc
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 :: Imm -> SDoc
228
229 pprImm (ImmInt i) = int i
230 pprImm (ImmInteger i) = integer i
231 pprImm (ImmCLbl l) = ppr l
232 pprImm (ImmIndex l i) = ppr 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 (ImmConstantSum a b) = pprImm a <> char '+' <> pprImm b
239 pprImm (ImmConstantDiff a b) = pprImm a <> char '-'
240 <> lparen <> pprImm b <> rparen
241
242 pprImm (LO i)
243 = sdocWithPlatform $ \platform ->
244 if platformOS platform == OSDarwin
245 then hcat [ text "lo16(", pprImm i, rparen ]
246 else pprImm i <> text "@l"
247
248 pprImm (HI i)
249 = sdocWithPlatform $ \platform ->
250 if platformOS platform == OSDarwin
251 then hcat [ text "hi16(", pprImm i, rparen ]
252 else pprImm i <> text "@h"
253
254 pprImm (HA i)
255 = sdocWithPlatform $ \platform ->
256 if platformOS platform == OSDarwin
257 then hcat [ text "ha16(", pprImm i, rparen ]
258 else pprImm i <> text "@ha"
259
260
261 pprAddr :: AddrMode -> SDoc
262 pprAddr (AddrRegReg r1 r2)
263 = pprReg r1 <+> ptext (sLit ", ") <+> pprReg r2
264
265 pprAddr (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg r1, char ')' ]
266 pprAddr (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg r1, char ')' ]
267 pprAddr (AddrRegImm r1 imm) = hcat [ pprImm imm, char '(', pprReg r1, char ')' ]
268
269
270 pprSectionHeader :: Section -> SDoc
271 pprSectionHeader seg
272 = sdocWithPlatform $ \platform ->
273 let osDarwin = platformOS platform == OSDarwin
274 in case seg of
275 Text -> ptext (sLit ".text\n.align 2")
276 Data -> ptext (sLit ".data\n.align 2")
277 ReadOnlyData
278 | osDarwin -> ptext (sLit ".const\n.align 2")
279 | otherwise -> ptext (sLit ".section .rodata\n\t.align 2")
280 RelocatableReadOnlyData
281 | osDarwin -> ptext (sLit ".const_data\n.align 2")
282 | otherwise -> ptext (sLit ".data\n\t.align 2")
283 UninitialisedData
284 | osDarwin -> ptext (sLit ".const_data\n.align 2")
285 | otherwise -> ptext (sLit ".section .bss\n\t.align 2")
286 ReadOnlyData16
287 | osDarwin -> ptext (sLit ".const\n.align 4")
288 | otherwise -> ptext (sLit ".section .rodata\n\t.align 4")
289 OtherSection _ ->
290 panic "PprMach.pprSectionHeader: unknown section"
291
292
293 pprDataItem :: CmmLit -> SDoc
294 pprDataItem 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 imm]
300
301 ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
302
303 ppr_item FF32 (CmmFloat r _)
304 = let bs = floatToBytes (fromRational r)
305 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (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 (ImmInt b)) bs
310
311 ppr_item II16 _ = [ptext (sLit "\t.short\t") <> pprImm 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 :: Instr -> SDoc
325
326 pprInstr (COMMENT _) = empty -- nuke 'em
327 {-
328 pprInstr (COMMENT s) =
329 if platformOS platform == OSLinux
330 then ptext (sLit "# ") <> ftext s
331 else ptext (sLit "; ") <> ftext s
332 -}
333 pprInstr (DELTA d)
334 = pprInstr (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 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 reg]
358 -}
359
360 pprInstr (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 reg,
375 ptext (sLit ", "),
376 pprAddr addr
377 ]
378 pprInstr (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 reg,
393 ptext (sLit ", "),
394 pprAddr addr
395 ]
396 pprInstr (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 reg,
404 ptext (sLit ", "),
405 pprAddr addr
406 ]
407 pprInstr (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 reg,
415 ptext (sLit ", "),
416 pprAddr addr
417 ]
418 pprInstr (LIS reg imm) = hcat [
419 char '\t',
420 ptext (sLit "lis"),
421 char '\t',
422 pprReg reg,
423 ptext (sLit ", "),
424 pprImm imm
425 ]
426 pprInstr (LI reg imm) = hcat [
427 char '\t',
428 ptext (sLit "li"),
429 char '\t',
430 pprReg reg,
431 ptext (sLit ", "),
432 pprImm imm
433 ]
434 pprInstr (MR reg1 reg2)
435 | reg1 == reg2 = empty
436 | otherwise = hcat [
437 char '\t',
438 sdocWithPlatform $ \platform ->
439 case targetClassOfReg platform reg1 of
440 RcInteger -> ptext (sLit "mr")
441 _ -> ptext (sLit "fmr"),
442 char '\t',
443 pprReg reg1,
444 ptext (sLit ", "),
445 pprReg reg2
446 ]
447 pprInstr (CMP sz reg ri) = hcat [
448 char '\t',
449 op,
450 char '\t',
451 pprReg reg,
452 ptext (sLit ", "),
453 pprRI ri
454 ]
455 where
456 op = hcat [
457 ptext (sLit "cmp"),
458 pprSize sz,
459 case ri of
460 RIReg _ -> empty
461 RIImm _ -> char 'i'
462 ]
463 pprInstr (CMPL sz reg ri) = hcat [
464 char '\t',
465 op,
466 char '\t',
467 pprReg reg,
468 ptext (sLit ", "),
469 pprRI ri
470 ]
471 where
472 op = hcat [
473 ptext (sLit "cmpl"),
474 pprSize sz,
475 case ri of
476 RIReg _ -> empty
477 RIImm _ -> char 'i'
478 ]
479 pprInstr (BCC cond blockid) = hcat [
480 char '\t',
481 ptext (sLit "b"),
482 pprCond cond,
483 char '\t',
484 ppr lbl
485 ]
486 where lbl = mkAsmTempLabel (getUnique blockid)
487
488 pprInstr (BCCFAR cond blockid) = vcat [
489 hcat [
490 ptext (sLit "\tb"),
491 pprCond (condNegate cond),
492 ptext (sLit "\t$+8")
493 ],
494 hcat [
495 ptext (sLit "\tb\t"),
496 ppr lbl
497 ]
498 ]
499 where lbl = mkAsmTempLabel (getUnique blockid)
500
501 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
502 char '\t',
503 ptext (sLit "b"),
504 char '\t',
505 ppr lbl
506 ]
507
508 pprInstr (MTCTR reg) = hcat [
509 char '\t',
510 ptext (sLit "mtctr"),
511 char '\t',
512 pprReg reg
513 ]
514 pprInstr (BCTR _ _) = hcat [
515 char '\t',
516 ptext (sLit "bctr")
517 ]
518 pprInstr (BL lbl _) = hcat [
519 ptext (sLit "\tbl\t"),
520 ppr lbl
521 ]
522 pprInstr (BCTRL _) = hcat [
523 char '\t',
524 ptext (sLit "bctrl")
525 ]
526 pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
527 pprInstr (ADDIS reg1 reg2 imm) = hcat [
528 char '\t',
529 ptext (sLit "addis"),
530 char '\t',
531 pprReg reg1,
532 ptext (sLit ", "),
533 pprReg reg2,
534 ptext (sLit ", "),
535 pprImm imm
536 ]
537
538 pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
539 pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
540 pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
541 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
542 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
543 pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
544 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
545
546 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
547 hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
548 pprReg reg2, ptext (sLit ", "),
549 pprReg reg3 ],
550 hcat [ ptext (sLit "\tmfxer\t"), pprReg reg1 ],
551 hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
552 pprReg reg1, ptext (sLit ", "),
553 ptext (sLit "2, 31, 31") ]
554 ]
555
556 -- for some reason, "andi" doesn't exist.
557 -- we'll use "andi." instead.
558 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
559 char '\t',
560 ptext (sLit "andi."),
561 char '\t',
562 pprReg reg1,
563 ptext (sLit ", "),
564 pprReg reg2,
565 ptext (sLit ", "),
566 pprImm imm
567 ]
568 pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
569
570 pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
571 pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
572
573 pprInstr (XORIS reg1 reg2 imm) = hcat [
574 char '\t',
575 ptext (sLit "xoris"),
576 char '\t',
577 pprReg reg1,
578 ptext (sLit ", "),
579 pprReg reg2,
580 ptext (sLit ", "),
581 pprImm imm
582 ]
583
584 pprInstr (EXTS sz reg1 reg2) = hcat [
585 char '\t',
586 ptext (sLit "exts"),
587 pprSize sz,
588 char '\t',
589 pprReg reg1,
590 ptext (sLit ", "),
591 pprReg reg2
592 ]
593
594 pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
595 pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
596
597 pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
598
599 pprInstr (SRW reg1 reg2 (RIImm (ImmInt i))) | i > 31 || i < 0 =
600 -- Handle the case where we are asked to shift a 32 bit register by
601 -- less than zero or more than 31 bits. We convert this into a clear
602 -- of the destination register.
603 -- Fixes ticket http://hackage.haskell.org/trac/ghc/ticket/5900
604 pprInstr (XOR reg1 reg2 (RIReg reg2))
605 pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
606
607 pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
608 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
609 ptext (sLit "\trlwinm\t"),
610 pprReg reg1,
611 ptext (sLit ", "),
612 pprReg reg2,
613 ptext (sLit ", "),
614 int sh,
615 ptext (sLit ", "),
616 int mb,
617 ptext (sLit ", "),
618 int me
619 ]
620
621 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
622 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
623 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
624 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
625 pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
626
627 pprInstr (FCMP reg1 reg2) = hcat [
628 char '\t',
629 ptext (sLit "fcmpu\tcr0, "),
630 -- Note: we're using fcmpu, not fcmpo
631 -- The difference is with fcmpo, compare with NaN is an invalid operation.
632 -- We don't handle invalid fp ops, so we don't care
633 pprReg reg1,
634 ptext (sLit ", "),
635 pprReg reg2
636 ]
637
638 pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
639 pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
640
641 pprInstr (CRNOR dst src1 src2) = hcat [
642 ptext (sLit "\tcrnor\t"),
643 int dst,
644 ptext (sLit ", "),
645 int src1,
646 ptext (sLit ", "),
647 int src2
648 ]
649
650 pprInstr (MFCR reg) = hcat [
651 char '\t',
652 ptext (sLit "mfcr"),
653 char '\t',
654 pprReg reg
655 ]
656
657 pprInstr (MFLR reg) = hcat [
658 char '\t',
659 ptext (sLit "mflr"),
660 char '\t',
661 pprReg reg
662 ]
663
664 pprInstr (FETCHPC reg) = vcat [
665 ptext (sLit "\tbcl\t20,31,1f"),
666 hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
667 ]
668
669 pprInstr LWSYNC = ptext (sLit "\tlwsync")
670
671 -- pprInstr _ = panic "pprInstr (ppc)"
672
673
674 pprLogic :: LitString -> Reg -> Reg -> RI -> SDoc
675 pprLogic op reg1 reg2 ri = hcat [
676 char '\t',
677 ptext op,
678 case ri of
679 RIReg _ -> empty
680 RIImm _ -> char 'i',
681 char '\t',
682 pprReg reg1,
683 ptext (sLit ", "),
684 pprReg reg2,
685 ptext (sLit ", "),
686 pprRI ri
687 ]
688
689
690 pprUnary :: LitString -> Reg -> Reg -> SDoc
691 pprUnary op reg1 reg2 = hcat [
692 char '\t',
693 ptext op,
694 char '\t',
695 pprReg reg1,
696 ptext (sLit ", "),
697 pprReg reg2
698 ]
699
700
701 pprBinaryF :: LitString -> Size -> Reg -> Reg -> Reg -> SDoc
702 pprBinaryF op sz reg1 reg2 reg3 = hcat [
703 char '\t',
704 ptext op,
705 pprFSize sz,
706 char '\t',
707 pprReg reg1,
708 ptext (sLit ", "),
709 pprReg reg2,
710 ptext (sLit ", "),
711 pprReg reg3
712 ]
713
714 pprRI :: RI -> SDoc
715 pprRI (RIReg r) = pprReg r
716 pprRI (RIImm r) = pprImm r
717
718
719 pprFSize :: Size -> SDoc
720 pprFSize FF64 = empty
721 pprFSize FF32 = char 's'
722 pprFSize _ = panic "PPC.Ppr.pprFSize: no match"
723
724 -- limit immediate argument for shift instruction to range 0..31
725 limitShiftRI :: RI -> RI
726 limitShiftRI (RIImm (ImmInt i)) | i > 31 || i < 0 =
727 panic $ "PPC.Ppr: Shift by " ++ show i ++ " bits is not allowed."
728 limitShiftRI x = x
729