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