never executed always true always false
1 {-# LANGUAGE LambdaCase #-}
2
3 -----------------------------------------------------------------------------
4 --
5 -- Pretty-printing assembly language
6 --
7 -- (c) The University of Glasgow 1993-2005
8 --
9 -----------------------------------------------------------------------------
10
11 module GHC.CmmToAsm.PPC.Ppr
12 ( pprNatCmmDecl
13 , pprInstr
14 )
15 where
16
17 import GHC.Prelude
18
19 import GHC.CmmToAsm.PPC.Regs
20 import GHC.CmmToAsm.PPC.Instr
21 import GHC.CmmToAsm.PPC.Cond
22 import GHC.CmmToAsm.Ppr
23 import GHC.CmmToAsm.Format
24 import GHC.Platform.Reg
25 import GHC.Platform.Reg.Class
26 import GHC.CmmToAsm.Reg.Target
27 import GHC.CmmToAsm.Config
28 import GHC.CmmToAsm.Types
29 import GHC.CmmToAsm.Utils
30
31 import GHC.Cmm hiding (topInfoTable)
32 import GHC.Cmm.Dataflow.Collections
33 import GHC.Cmm.Dataflow.Label
34
35 import GHC.Cmm.BlockId
36 import GHC.Cmm.CLabel
37 import GHC.Cmm.Ppr.Expr () -- For Outputable instances
38
39 import GHC.Types.Unique ( pprUniqueAlways, getUnique )
40 import GHC.Platform
41 import GHC.Utils.Outputable
42 import GHC.Utils.Panic
43
44 import Data.Word
45 import Data.Int
46
47 -- -----------------------------------------------------------------------------
48 -- Printing this stuff out
49
50 pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
51 pprNatCmmDecl config (CmmData section dats) =
52 pprSectionAlign config section
53 $$ pprDatas (ncgPlatform config) dats
54
55 pprNatCmmDecl config proc@(CmmProc top_info lbl _ (ListGraph blocks)) =
56 let platform = ncgPlatform config in
57 case topInfoTable proc of
58 Nothing ->
59 -- special case for code without info table:
60 pprSectionAlign config (Section Text lbl) $$
61 (case platformArch platform of
62 ArchPPC_64 ELF_V1 -> pprFunctionDescriptor platform lbl
63 ArchPPC_64 ELF_V2 -> pprFunctionPrologue platform lbl
64 _ -> pprLabel platform lbl) $$ -- blocks guaranteed not null,
65 -- so label needed
66 vcat (map (pprBasicBlock config top_info) blocks) $$
67 ppWhen (ncgDwarfEnabled config) (pdoc platform (mkAsmTempEndLabel lbl)
68 <> char ':' $$
69 pprProcEndLabel platform lbl) $$
70 pprSizeDecl platform lbl
71
72 Just (CmmStaticsRaw info_lbl _) ->
73 pprSectionAlign config (Section Text info_lbl) $$
74 (if platformHasSubsectionsViaSymbols platform
75 then pdoc platform (mkDeadStripPreventer info_lbl) <> char ':'
76 else empty) $$
77 vcat (map (pprBasicBlock config top_info) blocks) $$
78 -- above: Even the first block gets a label, because with branch-chain
79 -- elimination, it might be the target of a goto.
80 (if platformHasSubsectionsViaSymbols platform
81 then
82 -- See Note [Subsections Via Symbols] in X86/Ppr.hs
83 text "\t.long "
84 <+> pdoc platform info_lbl
85 <+> char '-'
86 <+> pdoc platform (mkDeadStripPreventer info_lbl)
87 else empty) $$
88 pprSizeDecl platform info_lbl
89
90 -- | Output the ELF .size directive.
91 pprSizeDecl :: Platform -> CLabel -> SDoc
92 pprSizeDecl platform lbl
93 = if osElfTarget (platformOS platform)
94 then text "\t.size" <+> prettyLbl <> text ", .-" <> codeLbl
95 else empty
96 where
97 prettyLbl = pdoc platform lbl
98 codeLbl
99 | platformArch platform == ArchPPC_64 ELF_V1 = char '.' <> prettyLbl
100 | otherwise = prettyLbl
101
102 pprFunctionDescriptor :: Platform -> CLabel -> SDoc
103 pprFunctionDescriptor platform lab = pprGloblDecl platform lab
104 $$ text "\t.section \".opd\", \"aw\""
105 $$ text "\t.align 3"
106 $$ pdoc platform lab <> char ':'
107 $$ text "\t.quad ."
108 <> pdoc platform lab
109 <> text ",.TOC.@tocbase,0"
110 $$ text "\t.previous"
111 $$ text "\t.type"
112 <+> pdoc platform lab
113 <> text ", @function"
114 $$ char '.' <> pdoc platform lab <> char ':'
115
116 pprFunctionPrologue :: Platform -> CLabel ->SDoc
117 pprFunctionPrologue platform lab = pprGloblDecl platform lab
118 $$ text ".type "
119 <> pdoc platform lab
120 <> text ", @function"
121 $$ pdoc platform lab <> char ':'
122 $$ text "0:\taddis\t" <> pprReg toc
123 <> text ",12,.TOC.-0b@ha"
124 $$ text "\taddi\t" <> pprReg toc
125 <> char ',' <> pprReg toc <> text ",.TOC.-0b@l"
126 $$ text "\t.localentry\t" <> pdoc platform lab
127 <> text ",.-" <> pdoc platform lab
128
129 pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name
130 -> SDoc
131 pprProcEndLabel platform lbl =
132 pdoc platform (mkAsmTempProcEndLabel lbl) <> char ':'
133
134 pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
135 -> SDoc
136 pprBasicBlock config info_env (BasicBlock blockid instrs)
137 = maybe_infotable $$
138 pprLabel platform asmLbl $$
139 vcat (map (pprInstr platform) instrs) $$
140 ppWhen (ncgDwarfEnabled config) (
141 pdoc platform (mkAsmTempEndLabel asmLbl) <> char ':'
142 <> pprProcEndLabel platform asmLbl
143 )
144 where
145 asmLbl = blockLbl blockid
146 platform = ncgPlatform config
147 maybe_infotable = case mapLookup blockid info_env of
148 Nothing -> empty
149 Just (CmmStaticsRaw info_lbl info) ->
150 pprAlignForSection platform Text $$
151 vcat (map (pprData platform) info) $$
152 pprLabel platform info_lbl
153
154
155
156 pprDatas :: Platform -> RawCmmStatics -> SDoc
157 -- See note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
158 pprDatas platform (CmmStaticsRaw alias [CmmStaticLit (CmmLabel lbl), CmmStaticLit ind, _, _])
159 | lbl == mkIndStaticInfoLabel
160 , let labelInd (CmmLabelOff l _) = Just l
161 labelInd (CmmLabel l) = Just l
162 labelInd _ = Nothing
163 , Just ind' <- labelInd ind
164 , alias `mayRedirectTo` ind'
165 = pprGloblDecl platform alias
166 $$ text ".equiv" <+> pdoc platform alias <> comma <> pdoc platform (CmmLabel ind')
167 pprDatas platform (CmmStaticsRaw lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
168
169 pprData :: Platform -> CmmStatic -> SDoc
170 pprData platform d = case d of
171 CmmString str -> pprString str
172 CmmFileEmbed path -> pprFileEmbed path
173 CmmUninitialised bytes -> text ".space " <> int bytes
174 CmmStaticLit lit -> pprDataItem platform lit
175
176 pprGloblDecl :: Platform -> CLabel -> SDoc
177 pprGloblDecl platform lbl
178 | not (externallyVisibleCLabel lbl) = empty
179 | otherwise = text ".globl " <> pdoc platform lbl
180
181 pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
182 pprTypeAndSizeDecl platform lbl
183 = if platformOS platform == OSLinux && externallyVisibleCLabel lbl
184 then text ".type " <>
185 pdoc platform lbl <> text ", @object"
186 else empty
187
188 pprLabel :: Platform -> CLabel -> SDoc
189 pprLabel platform lbl =
190 pprGloblDecl platform lbl
191 $$ pprTypeAndSizeDecl platform lbl
192 $$ (pdoc platform lbl <> char ':')
193
194 -- -----------------------------------------------------------------------------
195 -- pprInstr: print an 'Instr'
196
197 pprReg :: Reg -> SDoc
198
199 pprReg r
200 = case r of
201 RegReal (RealRegSingle i) -> ppr_reg_no i
202 RegReal (RealRegPair{}) -> panic "PPC.pprReg: no reg pairs on this arch"
203 RegVirtual (VirtualRegI u) -> text "%vI_" <> pprUniqueAlways u
204 RegVirtual (VirtualRegHi u) -> text "%vHi_" <> pprUniqueAlways u
205 RegVirtual (VirtualRegF u) -> text "%vF_" <> pprUniqueAlways u
206 RegVirtual (VirtualRegD u) -> text "%vD_" <> pprUniqueAlways u
207
208 where
209 ppr_reg_no :: Int -> SDoc
210 ppr_reg_no i
211 | i <= 31 = int i -- GPRs
212 | i <= 63 = int (i-32) -- FPRs
213 | otherwise = text "very naughty powerpc register"
214
215
216
217 pprFormat :: Format -> SDoc
218 pprFormat x
219 = case x of
220 II8 -> text "b"
221 II16 -> text "h"
222 II32 -> text "w"
223 II64 -> text "d"
224 FF32 -> text "fs"
225 FF64 -> text "fd"
226
227
228 pprCond :: Cond -> SDoc
229 pprCond c
230 = case c of {
231 ALWAYS -> text "";
232 EQQ -> text "eq"; NE -> text "ne";
233 LTT -> text "lt"; GE -> text "ge";
234 GTT -> text "gt"; LE -> text "le";
235 LU -> text "lt"; GEU -> text "ge";
236 GU -> text "gt"; LEU -> text "le"; }
237
238
239 pprImm :: Platform -> Imm -> SDoc
240 pprImm platform = \case
241 ImmInt i -> int i
242 ImmInteger i -> integer i
243 ImmCLbl l -> pdoc platform l
244 ImmIndex l i -> pdoc platform l <> char '+' <> int i
245 ImmLit s -> s
246 ImmFloat f -> float $ fromRational f
247 ImmDouble d -> double $ fromRational d
248 ImmConstantSum a b -> pprImm platform a <> char '+' <> pprImm platform b
249 ImmConstantDiff a b -> pprImm platform a <> char '-' <> lparen <> pprImm platform b <> rparen
250 LO (ImmInt i) -> pprImm platform (LO (ImmInteger (toInteger i)))
251 LO (ImmInteger i) -> pprImm platform (ImmInteger (toInteger lo16))
252 where
253 lo16 = fromInteger (i .&. 0xffff) :: Int16
254
255 LO i -> pprImm platform i <> text "@l"
256 HI i -> pprImm platform i <> text "@h"
257 HA (ImmInt i) -> pprImm platform (HA (ImmInteger (toInteger i)))
258 HA (ImmInteger i) -> pprImm platform (ImmInteger ha16)
259 where
260 ha16 = if lo16 >= 0x8000 then hi16+1 else hi16
261 hi16 = (i `shiftR` 16)
262 lo16 = i .&. 0xffff
263
264 HA i -> pprImm platform i <> text "@ha"
265 HIGHERA i -> pprImm platform i <> text "@highera"
266 HIGHESTA i -> pprImm platform i <> text "@highesta"
267
268
269 pprAddr :: Platform -> AddrMode -> SDoc
270 pprAddr platform = \case
271 AddrRegReg r1 r2 -> pprReg r1 <> char ',' <+> pprReg r2
272 AddrRegImm r1 (ImmInt i) -> hcat [ int i, char '(', pprReg r1, char ')' ]
273 AddrRegImm r1 (ImmInteger i) -> hcat [ integer i, char '(', pprReg r1, char ')' ]
274 AddrRegImm r1 imm -> hcat [ pprImm platform imm, char '(', pprReg r1, char ')' ]
275
276
277 pprSectionAlign :: NCGConfig -> Section -> SDoc
278 pprSectionAlign config sec@(Section seg _) =
279 pprSectionHeader config sec $$
280 pprAlignForSection (ncgPlatform config) seg
281
282 -- | Print appropriate alignment for the given section type.
283 pprAlignForSection :: Platform -> SectionType -> SDoc
284 pprAlignForSection platform seg =
285 let ppc64 = not $ target32Bit platform
286 in case seg of
287 Text -> text ".align 2"
288 Data
289 | ppc64 -> text ".align 3"
290 | otherwise -> text ".align 2"
291 ReadOnlyData
292 | ppc64 -> text ".align 3"
293 | otherwise -> text ".align 2"
294 RelocatableReadOnlyData
295 | ppc64 -> text ".align 3"
296 | otherwise -> text ".align 2"
297 UninitialisedData
298 | ppc64 -> text ".align 3"
299 | otherwise -> text ".align 2"
300 ReadOnlyData16 -> text ".align 4"
301 -- TODO: This is copied from the ReadOnlyData case, but it can likely be
302 -- made more efficient.
303 CString
304 | ppc64 -> text ".align 3"
305 | otherwise -> text ".align 2"
306 OtherSection _ -> panic "PprMach.pprSectionAlign: unknown section"
307
308 pprDataItem :: Platform -> CmmLit -> SDoc
309 pprDataItem platform lit
310 = vcat (ppr_item (cmmTypeFormat $ cmmLitType platform lit) lit)
311 where
312 imm = litToImm lit
313 archPPC_64 = not $ target32Bit platform
314
315 ppr_item II8 _ = [text "\t.byte\t" <> pprImm platform imm]
316 ppr_item II16 _ = [text "\t.short\t" <> pprImm platform imm]
317 ppr_item II32 _ = [text "\t.long\t" <> pprImm platform imm]
318 ppr_item II64 _
319 | archPPC_64 = [text "\t.quad\t" <> pprImm platform imm]
320
321 ppr_item II64 (CmmInt x _)
322 | not archPPC_64 =
323 [text "\t.long\t"
324 <> int (fromIntegral
325 (fromIntegral (x `shiftR` 32) :: Word32)),
326 text "\t.long\t"
327 <> int (fromIntegral (fromIntegral x :: Word32))]
328
329
330 ppr_item FF32 _ = [text "\t.float\t" <> pprImm platform imm]
331 ppr_item FF64 _ = [text "\t.double\t" <> pprImm platform imm]
332
333 ppr_item _ _
334 = panic "PPC.Ppr.pprDataItem: no match"
335
336
337 asmComment :: SDoc -> SDoc
338 asmComment c = whenPprDebug $ text "#" <+> c
339
340
341 pprInstr :: Platform -> Instr -> SDoc
342 pprInstr platform instr = case instr of
343
344 COMMENT s
345 -> asmComment s
346
347 LOCATION file line col _name
348 -> text "\t.loc" <+> ppr file <+> ppr line <+> ppr col
349
350 DELTA d
351 -> asmComment $ text ("\tdelta = " ++ show d)
352
353 NEWBLOCK _
354 -> panic "PprMach.pprInstr: NEWBLOCK"
355
356 LDATA _ _
357 -> panic "PprMach.pprInstr: LDATA"
358
359 {-
360 SPILL reg slot
361 -> hcat [
362 text "\tSPILL",
363 char '\t',
364 pprReg reg,
365 comma,
366 text "SLOT" <> parens (int slot)]
367
368 RELOAD slot reg
369 -> hcat [
370 text "\tRELOAD",
371 char '\t',
372 text "SLOT" <> parens (int slot),
373 comma,
374 pprReg reg]
375 -}
376
377 LD fmt reg addr
378 -> hcat [
379 char '\t',
380 text "l",
381 (case fmt of
382 II8 -> text "bz"
383 II16 -> text "hz"
384 II32 -> text "wz"
385 II64 -> text "d"
386 FF32 -> text "fs"
387 FF64 -> text "fd"
388 ),
389 case addr of AddrRegImm _ _ -> empty
390 AddrRegReg _ _ -> char 'x',
391 char '\t',
392 pprReg reg,
393 text ", ",
394 pprAddr platform addr
395 ]
396
397 LDFAR fmt reg (AddrRegImm source off)
398 -> vcat
399 [ pprInstr platform (ADDIS (tmpReg platform) source (HA off))
400 , pprInstr platform (LD fmt reg (AddrRegImm (tmpReg platform) (LO off)))
401 ]
402
403 LDFAR _ _ _
404 -> panic "PPC.Ppr.pprInstr LDFAR: no match"
405
406 LDR fmt reg1 addr
407 -> hcat [
408 text "\tl",
409 case fmt of
410 II32 -> char 'w'
411 II64 -> char 'd'
412 _ -> panic "PPC.Ppr.Instr LDR: no match",
413 text "arx\t",
414 pprReg reg1,
415 text ", ",
416 pprAddr platform addr
417 ]
418
419 LA fmt reg addr
420 -> hcat [
421 char '\t',
422 text "l",
423 (case fmt of
424 II8 -> text "ba"
425 II16 -> text "ha"
426 II32 -> text "wa"
427 II64 -> text "d"
428 FF32 -> text "fs"
429 FF64 -> text "fd"
430 ),
431 case addr of AddrRegImm _ _ -> empty
432 AddrRegReg _ _ -> char 'x',
433 char '\t',
434 pprReg reg,
435 text ", ",
436 pprAddr platform addr
437 ]
438
439 ST fmt reg addr
440 -> hcat [
441 char '\t',
442 text "st",
443 pprFormat fmt,
444 case addr of AddrRegImm _ _ -> empty
445 AddrRegReg _ _ -> char 'x',
446 char '\t',
447 pprReg reg,
448 text ", ",
449 pprAddr platform addr
450 ]
451
452 STFAR fmt reg (AddrRegImm source off)
453 -> vcat [ pprInstr platform (ADDIS (tmpReg platform) source (HA off))
454 , pprInstr platform (ST fmt reg (AddrRegImm (tmpReg platform) (LO off)))
455 ]
456
457 STFAR _ _ _
458 -> panic "PPC.Ppr.pprInstr STFAR: no match"
459
460 STU fmt reg addr
461 -> hcat [
462 char '\t',
463 text "st",
464 pprFormat fmt,
465 char 'u',
466 case addr of AddrRegImm _ _ -> empty
467 AddrRegReg _ _ -> char 'x',
468 char '\t',
469 pprReg reg,
470 text ", ",
471 pprAddr platform addr
472 ]
473
474 STC fmt reg1 addr
475 -> hcat [
476 text "\tst",
477 case fmt of
478 II32 -> char 'w'
479 II64 -> char 'd'
480 _ -> panic "PPC.Ppr.Instr STC: no match",
481 text "cx.\t",
482 pprReg reg1,
483 text ", ",
484 pprAddr platform addr
485 ]
486
487 LIS reg imm
488 -> hcat [
489 char '\t',
490 text "lis",
491 char '\t',
492 pprReg reg,
493 text ", ",
494 pprImm platform imm
495 ]
496
497 LI reg imm
498 -> hcat [
499 char '\t',
500 text "li",
501 char '\t',
502 pprReg reg,
503 text ", ",
504 pprImm platform imm
505 ]
506
507 MR reg1 reg2
508 | reg1 == reg2 -> empty
509 | otherwise -> hcat [
510 char '\t',
511 case targetClassOfReg platform reg1 of
512 RcInteger -> text "mr"
513 _ -> text "fmr",
514 char '\t',
515 pprReg reg1,
516 text ", ",
517 pprReg reg2
518 ]
519
520 CMP fmt reg ri
521 -> hcat [
522 char '\t',
523 op,
524 char '\t',
525 pprReg reg,
526 text ", ",
527 pprRI platform ri
528 ]
529 where
530 op = hcat [
531 text "cmp",
532 pprFormat fmt,
533 case ri of
534 RIReg _ -> empty
535 RIImm _ -> char 'i'
536 ]
537
538 CMPL fmt reg ri
539 -> hcat [
540 char '\t',
541 op,
542 char '\t',
543 pprReg reg,
544 text ", ",
545 pprRI platform ri
546 ]
547 where
548 op = hcat [
549 text "cmpl",
550 pprFormat fmt,
551 case ri of
552 RIReg _ -> empty
553 RIImm _ -> char 'i'
554 ]
555
556 BCC cond blockid prediction
557 -> hcat [
558 char '\t',
559 text "b",
560 pprCond cond,
561 pprPrediction prediction,
562 char '\t',
563 pdoc platform lbl
564 ]
565 where lbl = mkLocalBlockLabel (getUnique blockid)
566 pprPrediction p = case p of
567 Nothing -> empty
568 Just True -> char '+'
569 Just False -> char '-'
570
571 BCCFAR cond blockid prediction
572 -> vcat [
573 hcat [
574 text "\tb",
575 pprCond (condNegate cond),
576 neg_prediction,
577 text "\t$+8"
578 ],
579 hcat [
580 text "\tb\t",
581 pdoc platform lbl
582 ]
583 ]
584 where lbl = mkLocalBlockLabel (getUnique blockid)
585 neg_prediction = case prediction of
586 Nothing -> empty
587 Just True -> char '-'
588 Just False -> char '+'
589
590 JMP lbl _
591 -- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL"
592 | isForeignLabel lbl -> panic "PPC.Ppr.pprInstr: JMP to ForeignLabel"
593 | otherwise ->
594 hcat [ -- an alias for b that takes a CLabel
595 char '\t',
596 text "b",
597 char '\t',
598 pdoc platform lbl
599 ]
600
601 MTCTR reg
602 -> hcat [
603 char '\t',
604 text "mtctr",
605 char '\t',
606 pprReg reg
607 ]
608
609 BCTR _ _ _
610 -> hcat [
611 char '\t',
612 text "bctr"
613 ]
614
615 BL lbl _
616 -> case platformOS platform of
617 OSAIX ->
618 -- On AIX, "printf" denotes a function-descriptor (for use
619 -- by function pointers), whereas the actual entry-code
620 -- address is denoted by the dot-prefixed ".printf" label.
621 -- Moreover, the PPC NCG only ever emits a BL instruction
622 -- for calling C ABI functions. Most of the time these calls
623 -- originate from FFI imports and have a 'ForeignLabel',
624 -- but when profiling the codegen inserts calls via
625 -- 'emitRtsCallGen' which are 'CmmLabel's even though
626 -- they'd technically be more like 'ForeignLabel's.
627 hcat [
628 text "\tbl\t.",
629 pdoc platform lbl
630 ]
631 _ ->
632 hcat [
633 text "\tbl\t",
634 pdoc platform lbl
635 ]
636
637 BCTRL _
638 -> hcat [
639 char '\t',
640 text "bctrl"
641 ]
642
643 ADD reg1 reg2 ri
644 -> pprLogic platform (text "add") reg1 reg2 ri
645
646 ADDIS reg1 reg2 imm
647 -> hcat [
648 char '\t',
649 text "addis",
650 char '\t',
651 pprReg reg1,
652 text ", ",
653 pprReg reg2,
654 text ", ",
655 pprImm platform imm
656 ]
657
658 ADDO reg1 reg2 reg3
659 -> pprLogic platform (text "addo") reg1 reg2 (RIReg reg3)
660
661 ADDC reg1 reg2 reg3
662 -> pprLogic platform (text "addc") reg1 reg2 (RIReg reg3)
663
664 ADDE reg1 reg2 reg3
665 -> pprLogic platform (text "adde") reg1 reg2 (RIReg reg3)
666
667 ADDZE reg1 reg2
668 -> pprUnary (text "addze") reg1 reg2
669
670 SUBF reg1 reg2 reg3
671 -> pprLogic platform (text "subf") reg1 reg2 (RIReg reg3)
672
673 SUBFO reg1 reg2 reg3
674 -> pprLogic platform (text "subfo") reg1 reg2 (RIReg reg3)
675
676 SUBFC reg1 reg2 ri
677 -> hcat [
678 char '\t',
679 text "subf",
680 case ri of
681 RIReg _ -> empty
682 RIImm _ -> char 'i',
683 text "c\t",
684 pprReg reg1,
685 text ", ",
686 pprReg reg2,
687 text ", ",
688 pprRI platform ri
689 ]
690
691 SUBFE reg1 reg2 reg3
692 -> pprLogic platform (text "subfe") reg1 reg2 (RIReg reg3)
693
694 MULL fmt reg1 reg2 ri
695 -> pprMul platform fmt reg1 reg2 ri
696
697 MULLO fmt reg1 reg2 reg3
698 -> hcat [
699 char '\t',
700 text "mull",
701 case fmt of
702 II32 -> char 'w'
703 II64 -> char 'd'
704 _ -> panic "PPC: illegal format",
705 text "o\t",
706 pprReg reg1,
707 text ", ",
708 pprReg reg2,
709 text ", ",
710 pprReg reg3
711 ]
712
713 MFOV fmt reg
714 -> vcat [
715 hcat [
716 char '\t',
717 text "mfxer",
718 char '\t',
719 pprReg reg
720 ],
721 hcat [
722 char '\t',
723 text "extr",
724 case fmt of
725 II32 -> char 'w'
726 II64 -> char 'd'
727 _ -> panic "PPC: illegal format",
728 text "i\t",
729 pprReg reg,
730 text ", ",
731 pprReg reg,
732 text ", 1, ",
733 case fmt of
734 II32 -> text "1"
735 II64 -> text "33"
736 _ -> panic "PPC: illegal format"
737 ]
738 ]
739
740 MULHU fmt reg1 reg2 reg3
741 -> hcat [
742 char '\t',
743 text "mulh",
744 case fmt of
745 II32 -> char 'w'
746 II64 -> char 'd'
747 _ -> panic "PPC: illegal format",
748 text "u\t",
749 pprReg reg1,
750 text ", ",
751 pprReg reg2,
752 text ", ",
753 pprReg reg3
754 ]
755
756 DIV fmt sgn reg1 reg2 reg3
757 -> pprDiv fmt sgn reg1 reg2 reg3
758
759 -- for some reason, "andi" doesn't exist.
760 -- we'll use "andi." instead.
761 AND reg1 reg2 (RIImm imm)
762 -> hcat [
763 char '\t',
764 text "andi.",
765 char '\t',
766 pprReg reg1,
767 text ", ",
768 pprReg reg2,
769 text ", ",
770 pprImm platform imm
771 ]
772
773 AND reg1 reg2 ri
774 -> pprLogic platform (text "and") reg1 reg2 ri
775
776 ANDC reg1 reg2 reg3
777 -> pprLogic platform (text "andc") reg1 reg2 (RIReg reg3)
778
779 NAND reg1 reg2 reg3
780 -> pprLogic platform (text "nand") reg1 reg2 (RIReg reg3)
781
782 OR reg1 reg2 ri
783 -> pprLogic platform (text "or") reg1 reg2 ri
784
785 XOR reg1 reg2 ri
786 -> pprLogic platform (text "xor") reg1 reg2 ri
787
788 ORIS reg1 reg2 imm
789 -> hcat [
790 char '\t',
791 text "oris",
792 char '\t',
793 pprReg reg1,
794 text ", ",
795 pprReg reg2,
796 text ", ",
797 pprImm platform imm
798 ]
799
800 XORIS reg1 reg2 imm
801 -> hcat [
802 char '\t',
803 text "xoris",
804 char '\t',
805 pprReg reg1,
806 text ", ",
807 pprReg reg2,
808 text ", ",
809 pprImm platform imm
810 ]
811
812 EXTS fmt reg1 reg2
813 -> hcat [
814 char '\t',
815 text "exts",
816 pprFormat fmt,
817 char '\t',
818 pprReg reg1,
819 text ", ",
820 pprReg reg2
821 ]
822
823 CNTLZ fmt reg1 reg2
824 -> hcat [
825 char '\t',
826 text "cntlz",
827 case fmt of
828 II32 -> char 'w'
829 II64 -> char 'd'
830 _ -> panic "PPC: illegal format",
831 char '\t',
832 pprReg reg1,
833 text ", ",
834 pprReg reg2
835 ]
836
837 NEG reg1 reg2
838 -> pprUnary (text "neg") reg1 reg2
839
840 NOT reg1 reg2
841 -> pprUnary (text "not") reg1 reg2
842
843 SR II32 reg1 reg2 (RIImm (ImmInt i))
844 -- Handle the case where we are asked to shift a 32 bit register by
845 -- less than zero or more than 31 bits. We convert this into a clear
846 -- of the destination register.
847 -- Fixes ticket https://gitlab.haskell.org/ghc/ghc/issues/5900
848 | i < 0 || i > 31 -> pprInstr platform (XOR reg1 reg2 (RIReg reg2))
849
850 SL II32 reg1 reg2 (RIImm (ImmInt i))
851 -- As above for SR, but for left shifts.
852 -- Fixes ticket https://gitlab.haskell.org/ghc/ghc/issues/10870
853 | i < 0 || i > 31 -> pprInstr platform (XOR reg1 reg2 (RIReg reg2))
854
855 SRA II32 reg1 reg2 (RIImm (ImmInt i))
856 -- PT: I don't know what to do for negative shift amounts:
857 -- For now just panic.
858 --
859 -- For shift amounts greater than 31 set all bit to the
860 -- value of the sign bit, this also what sraw does.
861 | i > 31 -> pprInstr platform (SRA II32 reg1 reg2 (RIImm (ImmInt 31)))
862
863 SL fmt reg1 reg2 ri
864 -> let op = case fmt of
865 II32 -> text "slw"
866 II64 -> text "sld"
867 _ -> panic "PPC.Ppr.pprInstr: shift illegal size"
868 in pprLogic platform op reg1 reg2 (limitShiftRI fmt ri)
869
870 SR fmt reg1 reg2 ri
871 -> let op = case fmt of
872 II32 -> text "srw"
873 II64 -> text "srd"
874 _ -> panic "PPC.Ppr.pprInstr: shift illegal size"
875 in pprLogic platform op reg1 reg2 (limitShiftRI fmt ri)
876
877 SRA fmt reg1 reg2 ri
878 -> let op = case fmt of
879 II32 -> text "sraw"
880 II64 -> text "srad"
881 _ -> panic "PPC.Ppr.pprInstr: shift illegal size"
882 in pprLogic platform op reg1 reg2 (limitShiftRI fmt ri)
883
884 RLWINM reg1 reg2 sh mb me
885 -> hcat [
886 text "\trlwinm\t",
887 pprReg reg1,
888 text ", ",
889 pprReg reg2,
890 text ", ",
891 int sh,
892 text ", ",
893 int mb,
894 text ", ",
895 int me
896 ]
897
898 CLRLI fmt reg1 reg2 n
899 -> hcat [
900 text "\tclrl",
901 pprFormat fmt,
902 text "i ",
903 pprReg reg1,
904 text ", ",
905 pprReg reg2,
906 text ", ",
907 int n
908 ]
909
910 CLRRI fmt reg1 reg2 n
911 -> hcat [
912 text "\tclrr",
913 pprFormat fmt,
914 text "i ",
915 pprReg reg1,
916 text ", ",
917 pprReg reg2,
918 text ", ",
919 int n
920 ]
921
922 FADD fmt reg1 reg2 reg3
923 -> pprBinaryF (text "fadd") fmt reg1 reg2 reg3
924
925 FSUB fmt reg1 reg2 reg3
926 -> pprBinaryF (text "fsub") fmt reg1 reg2 reg3
927
928 FMUL fmt reg1 reg2 reg3
929 -> pprBinaryF (text "fmul") fmt reg1 reg2 reg3
930
931 FDIV fmt reg1 reg2 reg3
932 -> pprBinaryF (text "fdiv") fmt reg1 reg2 reg3
933
934 FABS reg1 reg2
935 -> pprUnary (text "fabs") reg1 reg2
936
937 FNEG reg1 reg2
938 -> pprUnary (text "fneg") reg1 reg2
939
940 FCMP reg1 reg2
941 -> hcat [
942 char '\t',
943 text "fcmpu\t0, ",
944 -- Note: we're using fcmpu, not fcmpo
945 -- The difference is with fcmpo, compare with NaN is an invalid operation.
946 -- We don't handle invalid fp ops, so we don't care.
947 -- Moreover, we use `fcmpu 0, ...` rather than `fcmpu cr0, ...` for
948 -- better portability since some non-GNU assembler (such as
949 -- IBM's `as`) tend not to support the symbolic register name cr0.
950 -- This matches the syntax that GCC seems to emit for PPC targets.
951 pprReg reg1,
952 text ", ",
953 pprReg reg2
954 ]
955
956 FCTIWZ reg1 reg2
957 -> pprUnary (text "fctiwz") reg1 reg2
958
959 FCTIDZ reg1 reg2
960 -> pprUnary (text "fctidz") reg1 reg2
961
962 FCFID reg1 reg2
963 -> pprUnary (text "fcfid") reg1 reg2
964
965 FRSP reg1 reg2
966 -> pprUnary (text "frsp") reg1 reg2
967
968 CRNOR dst src1 src2
969 -> hcat [
970 text "\tcrnor\t",
971 int dst,
972 text ", ",
973 int src1,
974 text ", ",
975 int src2
976 ]
977
978 MFCR reg
979 -> hcat [
980 char '\t',
981 text "mfcr",
982 char '\t',
983 pprReg reg
984 ]
985
986 MFLR reg
987 -> hcat [
988 char '\t',
989 text "mflr",
990 char '\t',
991 pprReg reg
992 ]
993
994 FETCHPC reg
995 -> vcat [
996 text "\tbcl\t20,31,1f",
997 hcat [ text "1:\tmflr\t", pprReg reg ]
998 ]
999
1000 HWSYNC
1001 -> text "\tsync"
1002
1003 ISYNC
1004 -> text "\tisync"
1005
1006 LWSYNC
1007 -> text "\tlwsync"
1008
1009 NOP
1010 -> text "\tnop"
1011
1012 pprLogic :: Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
1013 pprLogic platform op reg1 reg2 ri = hcat [
1014 char '\t',
1015 op,
1016 case ri of
1017 RIReg _ -> empty
1018 RIImm _ -> char 'i',
1019 char '\t',
1020 pprReg reg1,
1021 text ", ",
1022 pprReg reg2,
1023 text ", ",
1024 pprRI platform ri
1025 ]
1026
1027
1028 pprMul :: Platform -> Format -> Reg -> Reg -> RI -> SDoc
1029 pprMul platform fmt reg1 reg2 ri = hcat [
1030 char '\t',
1031 text "mull",
1032 case ri of
1033 RIReg _ -> case fmt of
1034 II32 -> char 'w'
1035 II64 -> char 'd'
1036 _ -> panic "PPC: illegal format"
1037 RIImm _ -> char 'i',
1038 char '\t',
1039 pprReg reg1,
1040 text ", ",
1041 pprReg reg2,
1042 text ", ",
1043 pprRI platform ri
1044 ]
1045
1046
1047 pprDiv :: Format -> Bool -> Reg -> Reg -> Reg -> SDoc
1048 pprDiv fmt sgn reg1 reg2 reg3 = hcat [
1049 char '\t',
1050 text "div",
1051 case fmt of
1052 II32 -> char 'w'
1053 II64 -> char 'd'
1054 _ -> panic "PPC: illegal format",
1055 if sgn then empty else char 'u',
1056 char '\t',
1057 pprReg reg1,
1058 text ", ",
1059 pprReg reg2,
1060 text ", ",
1061 pprReg reg3
1062 ]
1063
1064
1065 pprUnary :: SDoc -> Reg -> Reg -> SDoc
1066 pprUnary op reg1 reg2 = hcat [
1067 char '\t',
1068 op,
1069 char '\t',
1070 pprReg reg1,
1071 text ", ",
1072 pprReg reg2
1073 ]
1074
1075
1076 pprBinaryF :: SDoc -> Format -> Reg -> Reg -> Reg -> SDoc
1077 pprBinaryF op fmt reg1 reg2 reg3 = hcat [
1078 char '\t',
1079 op,
1080 pprFFormat fmt,
1081 char '\t',
1082 pprReg reg1,
1083 text ", ",
1084 pprReg reg2,
1085 text ", ",
1086 pprReg reg3
1087 ]
1088
1089 pprRI :: Platform -> RI -> SDoc
1090 pprRI _ (RIReg r) = pprReg r
1091 pprRI platform (RIImm r) = pprImm platform r
1092
1093
1094 pprFFormat :: Format -> SDoc
1095 pprFFormat FF64 = empty
1096 pprFFormat FF32 = char 's'
1097 pprFFormat _ = panic "PPC.Ppr.pprFFormat: no match"
1098
1099 -- limit immediate argument for shift instruction to range 0..63
1100 -- for 64 bit size and 0..32 otherwise
1101 limitShiftRI :: Format -> RI -> RI
1102 limitShiftRI II64 (RIImm (ImmInt i)) | i > 63 || i < 0 =
1103 panic $ "PPC.Ppr: Shift by " ++ show i ++ " bits is not allowed."
1104 limitShiftRI II32 (RIImm (ImmInt i)) | i > 31 || i < 0 =
1105 panic $ "PPC.Ppr: 32 bit: Shift by " ++ show i ++ " bits is not allowed."
1106 limitShiftRI _ x = x