powerpc: fix and enable shared libraries by default on linux
[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 Cmm hiding (topInfoTable)
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 -- See Note [Subsections Via Symbols]
77 text "\t.long "
78 <+> ppr info_lbl
79 <+> char '-'
80 <+> ppr (mkDeadStripPreventer info_lbl)
81 else empty)
82
83
84 pprBasicBlock :: BlockEnv CmmStatics -> NatBasicBlock Instr -> SDoc
85 pprBasicBlock info_env (BasicBlock blockid instrs)
86 = maybe_infotable $$
87 pprLabel (mkAsmTempLabel (getUnique blockid)) $$
88 vcat (map pprInstr instrs)
89 where
90 maybe_infotable = case mapLookup blockid info_env of
91 Nothing -> empty
92 Just (Statics info_lbl info) ->
93 pprSectionHeader Text $$
94 vcat (map pprData info) $$
95 pprLabel info_lbl
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 in
274 case seg of
275 Text -> text ".text\n\t.align 2"
276 Data -> text ".data\n\t.align 2"
277 ReadOnlyData
278 | osDarwin -> text ".const\n\t.align 2"
279 | otherwise -> text ".section .rodata\n\t.align 2"
280 RelocatableReadOnlyData
281 | osDarwin -> text ".const_data\n\t.align 2"
282 | otherwise -> text ".data\n\t.align 2"
283 UninitialisedData
284 | osDarwin -> text ".const_data\n\t.align 2"
285 | otherwise -> text ".section .bss\n\t.align 2"
286 ReadOnlyData16
287 | osDarwin -> text ".const\n\t.align 4"
288 | otherwise -> text ".section .rodata\n\t.align 4"
289 OtherSection _ ->
290 panic "PprMach.pprSectionHeader: unknown section"
291
292
293 pprDataItem :: CmmLit -> SDoc
294 pprDataItem lit
295 = sdocWithDynFlags $ \dflags ->
296 vcat (ppr_item (cmmTypeSize $ cmmLitType dflags lit) lit)
297 where
298 imm = litToImm lit
299
300 ppr_item II8 _ = [ptext (sLit "\t.byte\t") <> pprImm imm]
301
302 ppr_item II32 _ = [ptext (sLit "\t.long\t") <> pprImm imm]
303
304 ppr_item FF32 (CmmFloat r _)
305 = let bs = floatToBytes (fromRational r)
306 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
307
308 ppr_item FF64 (CmmFloat r _)
309 = let bs = doubleToBytes (fromRational r)
310 in map (\b -> ptext (sLit "\t.byte\t") <> pprImm (ImmInt b)) bs
311
312 ppr_item II16 _ = [ptext (sLit "\t.short\t") <> pprImm imm]
313
314 ppr_item II64 (CmmInt x _) =
315 [ptext (sLit "\t.long\t")
316 <> int (fromIntegral
317 (fromIntegral (x `shiftR` 32) :: Word32)),
318 ptext (sLit "\t.long\t")
319 <> int (fromIntegral (fromIntegral x :: Word32))]
320
321 ppr_item _ _
322 = panic "PPC.Ppr.pprDataItem: no match"
323
324
325 pprInstr :: Instr -> SDoc
326
327 pprInstr (COMMENT _) = empty -- nuke 'em
328 {-
329 pprInstr (COMMENT s) =
330 if platformOS platform == OSLinux
331 then ptext (sLit "# ") <> ftext s
332 else ptext (sLit "; ") <> ftext s
333 -}
334 pprInstr (DELTA d)
335 = pprInstr (COMMENT (mkFastString ("\tdelta = " ++ show d)))
336
337 pprInstr (NEWBLOCK _)
338 = panic "PprMach.pprInstr: NEWBLOCK"
339
340 pprInstr (LDATA _ _)
341 = panic "PprMach.pprInstr: LDATA"
342
343 {-
344 pprInstr (SPILL reg slot)
345 = hcat [
346 ptext (sLit "\tSPILL"),
347 char '\t',
348 pprReg reg,
349 comma,
350 ptext (sLit "SLOT") <> parens (int slot)]
351
352 pprInstr (RELOAD slot reg)
353 = hcat [
354 ptext (sLit "\tRELOAD"),
355 char '\t',
356 ptext (sLit "SLOT") <> parens (int slot),
357 comma,
358 pprReg reg]
359 -}
360
361 pprInstr (LD sz reg addr) = hcat [
362 char '\t',
363 ptext (sLit "l"),
364 ptext (case sz of
365 II8 -> sLit "bz"
366 II16 -> sLit "hz"
367 II32 -> sLit "wz"
368 FF32 -> sLit "fs"
369 FF64 -> sLit "fd"
370 _ -> panic "PPC.Ppr.pprInstr: no match"
371 ),
372 case addr of AddrRegImm _ _ -> empty
373 AddrRegReg _ _ -> char 'x',
374 char '\t',
375 pprReg reg,
376 ptext (sLit ", "),
377 pprAddr addr
378 ]
379 pprInstr (LA sz reg addr) = hcat [
380 char '\t',
381 ptext (sLit "l"),
382 ptext (case sz of
383 II8 -> sLit "ba"
384 II16 -> sLit "ha"
385 II32 -> sLit "wa"
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 addr
396 ]
397 pprInstr (ST sz reg addr) = hcat [
398 char '\t',
399 ptext (sLit "st"),
400 pprSize sz,
401 case addr of AddrRegImm _ _ -> empty
402 AddrRegReg _ _ -> char 'x',
403 char '\t',
404 pprReg reg,
405 ptext (sLit ", "),
406 pprAddr addr
407 ]
408 pprInstr (STU sz reg addr) = hcat [
409 char '\t',
410 ptext (sLit "st"),
411 pprSize sz,
412 ptext (sLit "u\t"),
413 case addr of AddrRegImm _ _ -> empty
414 AddrRegReg _ _ -> char 'x',
415 pprReg reg,
416 ptext (sLit ", "),
417 pprAddr addr
418 ]
419 pprInstr (LIS reg imm) = hcat [
420 char '\t',
421 ptext (sLit "lis"),
422 char '\t',
423 pprReg reg,
424 ptext (sLit ", "),
425 pprImm imm
426 ]
427 pprInstr (LI reg imm) = hcat [
428 char '\t',
429 ptext (sLit "li"),
430 char '\t',
431 pprReg reg,
432 ptext (sLit ", "),
433 pprImm imm
434 ]
435 pprInstr (MR reg1 reg2)
436 | reg1 == reg2 = empty
437 | otherwise = hcat [
438 char '\t',
439 sdocWithPlatform $ \platform ->
440 case targetClassOfReg platform reg1 of
441 RcInteger -> ptext (sLit "mr")
442 _ -> ptext (sLit "fmr"),
443 char '\t',
444 pprReg reg1,
445 ptext (sLit ", "),
446 pprReg reg2
447 ]
448 pprInstr (CMP sz reg ri) = hcat [
449 char '\t',
450 op,
451 char '\t',
452 pprReg reg,
453 ptext (sLit ", "),
454 pprRI ri
455 ]
456 where
457 op = hcat [
458 ptext (sLit "cmp"),
459 pprSize sz,
460 case ri of
461 RIReg _ -> empty
462 RIImm _ -> char 'i'
463 ]
464 pprInstr (CMPL sz reg ri) = hcat [
465 char '\t',
466 op,
467 char '\t',
468 pprReg reg,
469 ptext (sLit ", "),
470 pprRI ri
471 ]
472 where
473 op = hcat [
474 ptext (sLit "cmpl"),
475 pprSize sz,
476 case ri of
477 RIReg _ -> empty
478 RIImm _ -> char 'i'
479 ]
480 pprInstr (BCC cond blockid) = hcat [
481 char '\t',
482 ptext (sLit "b"),
483 pprCond cond,
484 char '\t',
485 ppr lbl
486 ]
487 where lbl = mkAsmTempLabel (getUnique blockid)
488
489 pprInstr (BCCFAR cond blockid) = vcat [
490 hcat [
491 ptext (sLit "\tb"),
492 pprCond (condNegate cond),
493 ptext (sLit "\t$+8")
494 ],
495 hcat [
496 ptext (sLit "\tb\t"),
497 ppr lbl
498 ]
499 ]
500 where lbl = mkAsmTempLabel (getUnique blockid)
501
502 pprInstr (JMP lbl) = hcat [ -- an alias for b that takes a CLabel
503 char '\t',
504 ptext (sLit "b"),
505 char '\t',
506 ppr lbl
507 ]
508
509 pprInstr (MTCTR reg) = hcat [
510 char '\t',
511 ptext (sLit "mtctr"),
512 char '\t',
513 pprReg reg
514 ]
515 pprInstr (BCTR _ _) = hcat [
516 char '\t',
517 ptext (sLit "bctr")
518 ]
519 pprInstr (BL lbl _) = hcat [
520 ptext (sLit "\tbl\t"),
521 ppr lbl
522 ]
523 pprInstr (BCTRL _) = hcat [
524 char '\t',
525 ptext (sLit "bctrl")
526 ]
527 pprInstr (ADD reg1 reg2 ri) = pprLogic (sLit "add") reg1 reg2 ri
528 pprInstr (ADDI reg1 reg2 imm) = hcat [
529 char '\t',
530 ptext (sLit "addi"),
531 char '\t',
532 pprReg reg1,
533 ptext (sLit ", "),
534 pprReg reg2,
535 ptext (sLit ", "),
536 pprImm imm
537 ]
538 pprInstr (ADDIS reg1 reg2 imm) = hcat [
539 char '\t',
540 ptext (sLit "addis"),
541 char '\t',
542 pprReg reg1,
543 ptext (sLit ", "),
544 pprReg reg2,
545 ptext (sLit ", "),
546 pprImm imm
547 ]
548
549 pprInstr (ADDC reg1 reg2 reg3) = pprLogic (sLit "addc") reg1 reg2 (RIReg reg3)
550 pprInstr (ADDE reg1 reg2 reg3) = pprLogic (sLit "adde") reg1 reg2 (RIReg reg3)
551 pprInstr (SUBF reg1 reg2 reg3) = pprLogic (sLit "subf") reg1 reg2 (RIReg reg3)
552 pprInstr (SUBFC reg1 reg2 reg3) = pprLogic (sLit "subfc") reg1 reg2 (RIReg reg3)
553 pprInstr (SUBFE reg1 reg2 reg3) = pprLogic (sLit "subfe") reg1 reg2 (RIReg reg3)
554 pprInstr (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic (sLit "mullw") reg1 reg2 ri
555 pprInstr (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic (sLit "mull") reg1 reg2 ri
556 pprInstr (DIVW reg1 reg2 reg3) = pprLogic (sLit "divw") reg1 reg2 (RIReg reg3)
557 pprInstr (DIVWU reg1 reg2 reg3) = pprLogic (sLit "divwu") reg1 reg2 (RIReg reg3)
558
559 pprInstr (MULLW_MayOflo reg1 reg2 reg3) = vcat [
560 hcat [ ptext (sLit "\tmullwo\t"), pprReg reg1, ptext (sLit ", "),
561 pprReg reg2, ptext (sLit ", "),
562 pprReg reg3 ],
563 hcat [ ptext (sLit "\tmfxer\t"), pprReg reg1 ],
564 hcat [ ptext (sLit "\trlwinm\t"), pprReg reg1, ptext (sLit ", "),
565 pprReg reg1, ptext (sLit ", "),
566 ptext (sLit "2, 31, 31") ]
567 ]
568
569 -- for some reason, "andi" doesn't exist.
570 -- we'll use "andi." instead.
571 pprInstr (AND reg1 reg2 (RIImm imm)) = hcat [
572 char '\t',
573 ptext (sLit "andi."),
574 char '\t',
575 pprReg reg1,
576 ptext (sLit ", "),
577 pprReg reg2,
578 ptext (sLit ", "),
579 pprImm imm
580 ]
581 pprInstr (AND reg1 reg2 ri) = pprLogic (sLit "and") reg1 reg2 ri
582
583 pprInstr (OR reg1 reg2 ri) = pprLogic (sLit "or") reg1 reg2 ri
584 pprInstr (XOR reg1 reg2 ri) = pprLogic (sLit "xor") reg1 reg2 ri
585
586 pprInstr (XORIS reg1 reg2 imm) = hcat [
587 char '\t',
588 ptext (sLit "xoris"),
589 char '\t',
590 pprReg reg1,
591 ptext (sLit ", "),
592 pprReg reg2,
593 ptext (sLit ", "),
594 pprImm imm
595 ]
596
597 pprInstr (EXTS sz reg1 reg2) = hcat [
598 char '\t',
599 ptext (sLit "exts"),
600 pprSize sz,
601 char '\t',
602 pprReg reg1,
603 ptext (sLit ", "),
604 pprReg reg2
605 ]
606
607 pprInstr (NEG reg1 reg2) = pprUnary (sLit "neg") reg1 reg2
608 pprInstr (NOT reg1 reg2) = pprUnary (sLit "not") reg1 reg2
609
610 pprInstr (SLW reg1 reg2 ri) = pprLogic (sLit "slw") reg1 reg2 (limitShiftRI ri)
611
612 pprInstr (SRW reg1 reg2 (RIImm (ImmInt i))) | i > 31 || i < 0 =
613 -- Handle the case where we are asked to shift a 32 bit register by
614 -- less than zero or more than 31 bits. We convert this into a clear
615 -- of the destination register.
616 -- Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/5900
617 pprInstr (XOR reg1 reg2 (RIReg reg2))
618 pprInstr (SRW reg1 reg2 ri) = pprLogic (sLit "srw") reg1 reg2 (limitShiftRI ri)
619
620 pprInstr (SRAW reg1 reg2 ri) = pprLogic (sLit "sraw") reg1 reg2 (limitShiftRI ri)
621 pprInstr (RLWINM reg1 reg2 sh mb me) = hcat [
622 ptext (sLit "\trlwinm\t"),
623 pprReg reg1,
624 ptext (sLit ", "),
625 pprReg reg2,
626 ptext (sLit ", "),
627 int sh,
628 ptext (sLit ", "),
629 int mb,
630 ptext (sLit ", "),
631 int me
632 ]
633
634 pprInstr (FADD sz reg1 reg2 reg3) = pprBinaryF (sLit "fadd") sz reg1 reg2 reg3
635 pprInstr (FSUB sz reg1 reg2 reg3) = pprBinaryF (sLit "fsub") sz reg1 reg2 reg3
636 pprInstr (FMUL sz reg1 reg2 reg3) = pprBinaryF (sLit "fmul") sz reg1 reg2 reg3
637 pprInstr (FDIV sz reg1 reg2 reg3) = pprBinaryF (sLit "fdiv") sz reg1 reg2 reg3
638 pprInstr (FNEG reg1 reg2) = pprUnary (sLit "fneg") reg1 reg2
639
640 pprInstr (FCMP reg1 reg2) = hcat [
641 char '\t',
642 ptext (sLit "fcmpu\tcr0, "),
643 -- Note: we're using fcmpu, not fcmpo
644 -- The difference is with fcmpo, compare with NaN is an invalid operation.
645 -- We don't handle invalid fp ops, so we don't care
646 pprReg reg1,
647 ptext (sLit ", "),
648 pprReg reg2
649 ]
650
651 pprInstr (FCTIWZ reg1 reg2) = pprUnary (sLit "fctiwz") reg1 reg2
652 pprInstr (FRSP reg1 reg2) = pprUnary (sLit "frsp") reg1 reg2
653
654 pprInstr (CRNOR dst src1 src2) = hcat [
655 ptext (sLit "\tcrnor\t"),
656 int dst,
657 ptext (sLit ", "),
658 int src1,
659 ptext (sLit ", "),
660 int src2
661 ]
662
663 pprInstr (MFCR reg) = hcat [
664 char '\t',
665 ptext (sLit "mfcr"),
666 char '\t',
667 pprReg reg
668 ]
669
670 pprInstr (MFLR reg) = hcat [
671 char '\t',
672 ptext (sLit "mflr"),
673 char '\t',
674 pprReg reg
675 ]
676
677 pprInstr (FETCHPC reg) = vcat [
678 ptext (sLit "\tbcl\t20,31,1f"),
679 hcat [ ptext (sLit "1:\tmflr\t"), pprReg reg ]
680 ]
681
682 pprInstr LWSYNC = ptext (sLit "\tlwsync")
683
684 -- pprInstr _ = panic "pprInstr (ppc)"
685
686
687 pprLogic :: LitString -> Reg -> Reg -> RI -> SDoc
688 pprLogic op reg1 reg2 ri = hcat [
689 char '\t',
690 ptext op,
691 case ri of
692 RIReg _ -> empty
693 RIImm _ -> char 'i',
694 char '\t',
695 pprReg reg1,
696 ptext (sLit ", "),
697 pprReg reg2,
698 ptext (sLit ", "),
699 pprRI ri
700 ]
701
702
703 pprUnary :: LitString -> Reg -> Reg -> SDoc
704 pprUnary op reg1 reg2 = hcat [
705 char '\t',
706 ptext op,
707 char '\t',
708 pprReg reg1,
709 ptext (sLit ", "),
710 pprReg reg2
711 ]
712
713
714 pprBinaryF :: LitString -> Size -> Reg -> Reg -> Reg -> SDoc
715 pprBinaryF op sz reg1 reg2 reg3 = hcat [
716 char '\t',
717 ptext op,
718 pprFSize sz,
719 char '\t',
720 pprReg reg1,
721 ptext (sLit ", "),
722 pprReg reg2,
723 ptext (sLit ", "),
724 pprReg reg3
725 ]
726
727 pprRI :: RI -> SDoc
728 pprRI (RIReg r) = pprReg r
729 pprRI (RIImm r) = pprImm r
730
731
732 pprFSize :: Size -> SDoc
733 pprFSize FF64 = empty
734 pprFSize FF32 = char 's'
735 pprFSize _ = panic "PPC.Ppr.pprFSize: no match"
736
737 -- limit immediate argument for shift instruction to range 0..31
738 limitShiftRI :: RI -> RI
739 limitShiftRI (RIImm (ImmInt i)) | i > 31 || i < 0 =
740 panic $ "PPC.Ppr: Shift by " ++ show i ++ " bits is not allowed."
741 limitShiftRI x = x
742