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