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