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