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