Ppr.hs 21.4 KB
Newer Older
1
2
3
4
5
6
7
8
9
-----------------------------------------------------------------------------
--
-- Pretty-printing assembly language
--
-- (c) The University of Glasgow 1993-2005
--
-----------------------------------------------------------------------------

module PPC.Ppr (
Simon Peyton Jones's avatar
Simon Peyton Jones committed
10
	pprNatCmmDecl,
11
12
13
14
	pprBasicBlock,
	pprSectionHeader,
	pprData,
	pprInstr,
15
16
17
18
19
20
21
22
23
	pprSize,
	pprImm,
	pprDataItem,
)

where

import PPC.Regs
import PPC.Instr
24
25
26
27
28
29
import PPC.Cond
import PprBase
import Instruction
import Size
import Reg
import RegClass
30
import TargetReg
31

32
import OldCmm
33

34
import CLabel
35

36
import Unique		( pprUnique, Uniquable(..) )
Ian Lynagh's avatar
Ian Lynagh committed
37
import Platform
38
39
40
import Pretty
import FastString
import qualified Outputable
41
import Outputable ( PlatformOutputable, panic )
42

43
import Data.Word
44
45
46
import Data.Bits


47
48
49
-- -----------------------------------------------------------------------------
-- Printing this stuff out

Simon Peyton Jones's avatar
Simon Peyton Jones committed
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
56
pprNatCmmDecl platform (CmmProc Nothing lbl (ListGraph []))
    = pprLabel platform lbl
57

58
 -- special case for code without an info table:
Simon Peyton Jones's avatar
Simon Peyton Jones committed
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

Simon Peyton Jones's avatar
Simon Peyton Jones committed
64
pprNatCmmDecl platform (CmmProc (Just (Statics info_lbl info)) _entry_lbl (ListGraph blocks)) =
65
  pprSectionHeader platform Text $$
66
  (
67
68
69
       (if platformHasSubsectionsViaSymbols platform
        then pprCLabel_asm platform (mkDeadStripPreventer info_lbl) <> char ':'
        else empty) $$
70
71
       vcat (map (pprData platform) info) $$
       pprLabel platform info_lbl
72
  ) $$
73
  vcat (map (pprBasicBlock platform) blocks) $$
74
75
     -- above: Even the first block gets a label, because with branch-chain
     -- elimination, it might be the target of a goto.
76
77
78
79
80
81
82
83
84
85
86
87
88
        (if platformHasSubsectionsViaSymbols platform
         then
         -- If we are using the .subsections_via_symbols directive
         -- (available on recent versions of Darwin),
         -- we have to make sure that there is some kind of reference
         -- from the entry code to a label on the _top_ of of the info table,
         -- so that the linker will not think it is unreferenced and dead-strip
         -- it. That's why the label is called a DeadStripPreventer (_dsp).
                  text "\t.long "
              <+> pprCLabel_asm platform info_lbl
              <+> char '-'
              <+> pprCLabel_asm platform (mkDeadStripPreventer info_lbl)
         else empty)
89
90


91
92
pprBasicBlock :: Platform -> NatBasicBlock Instr -> Doc
pprBasicBlock platform (BasicBlock blockid instrs) =
93
  pprLabel platform (mkAsmTempLabel (getUnique blockid)) $$
94
  vcat (map (pprInstr platform) instrs)
95
96


97

98
99
pprDatas :: Platform -> CmmStatics -> Doc
pprDatas platform (Statics lbl dats) = vcat (pprLabel platform lbl : map (pprData platform) dats)
100

101
102
pprData :: Platform -> CmmStatic -> Doc
pprData _ (CmmString str)          = pprASCII str
103
104
105
106
pprData platform (CmmUninitialised bytes) = ptext (sLit keyword) <> int bytes
    where keyword = case platformOS platform of
                    OSDarwin -> ".space "
                    _        -> ".skip "
107
pprData platform (CmmStaticLit lit)       = pprDataItem platform lit
108

109
110
pprGloblDecl :: Platform -> CLabel -> Doc
pprGloblDecl platform lbl
111
  | not (externallyVisibleCLabel lbl) = empty
112
  | otherwise = ptext (sLit ".globl ") <> pprCLabel_asm platform lbl
113

114
115
pprTypeAndSizeDecl :: Platform -> CLabel -> Doc
pprTypeAndSizeDecl platform lbl
116
117
118
  | platformOS platform == OSLinux && externallyVisibleCLabel lbl
    = ptext (sLit ".type ") <>
      pprCLabel_asm platform lbl <> ptext (sLit ", @object")
119
pprTypeAndSizeDecl _ _
120
121
  = empty

122
123
124
125
pprLabel :: Platform -> CLabel -> Doc
pprLabel platform lbl = pprGloblDecl platform lbl
                     $$ pprTypeAndSizeDecl platform lbl
                     $$ (pprCLabel_asm platform lbl <> char ':')
126
127
128
129
130
131
132
133
134
135
136
137
138


pprASCII :: [Word8] -> Doc
pprASCII str
  = vcat (map do1 str) $$ do1 0
    where
       do1 :: Word8 -> Doc
       do1 w = ptext (sLit "\t.byte\t") <> int (fromIntegral w)


-- -----------------------------------------------------------------------------
-- pprInstr: print an 'Instr'

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
148
149
150
151
152
      RegReal    (RealRegSingle i) -> ppr_reg_no i
      RegReal    (RealRegPair{})   -> panic "PPC.pprReg: no reg pairs on this arch"
      RegVirtual (VirtualRegI  u)  -> text "%vI_" <> asmSDoc (pprUnique u)
      RegVirtual (VirtualRegHi u)  -> text "%vHi_" <> asmSDoc (pprUnique u)
      RegVirtual (VirtualRegF  u)  -> text "%vF_" <> asmSDoc (pprUnique u)
      RegVirtual (VirtualRegD  u)  -> text "%vD_" <> asmSDoc (pprUnique u)
153
      RegVirtual (VirtualRegSSE  u) -> text "%vSSE_" <> asmSDoc (pprUnique u)
154
155
  where
    ppr_reg_no :: Int -> Doc
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    ppr_reg_no i =
        case platformOS platform of
        OSDarwin ->
            ptext
                (case i of {
                 0 -> sLit "r0";   1 -> sLit "r1";
                 2 -> sLit "r2";   3 -> sLit "r3";
                 4 -> sLit "r4";   5 -> sLit "r5";
                 6 -> sLit "r6";   7 -> sLit "r7";
                 8 -> sLit "r8";   9 -> sLit "r9";
                10 -> sLit "r10";  11 -> sLit "r11";
                12 -> sLit "r12";  13 -> sLit "r13";
                14 -> sLit "r14";  15 -> sLit "r15";
                16 -> sLit "r16";  17 -> sLit "r17";
                18 -> sLit "r18";  19 -> sLit "r19";
                20 -> sLit "r20";  21 -> sLit "r21";
                22 -> sLit "r22";  23 -> sLit "r23";
                24 -> sLit "r24";  25 -> sLit "r25";
                26 -> sLit "r26";  27 -> sLit "r27";
                28 -> sLit "r28";  29 -> sLit "r29";
                30 -> sLit "r30";  31 -> sLit "r31";
                32 -> sLit "f0";  33 -> sLit "f1";
                34 -> sLit "f2";  35 -> sLit "f3";
                36 -> sLit "f4";  37 -> sLit "f5";
                38 -> sLit "f6";  39 -> sLit "f7";
                40 -> sLit "f8";  41 -> sLit "f9";
                42 -> sLit "f10"; 43 -> sLit "f11";
                44 -> sLit "f12"; 45 -> sLit "f13";
                46 -> sLit "f14"; 47 -> sLit "f15";
                48 -> sLit "f16"; 49 -> sLit "f17";
                50 -> sLit "f18"; 51 -> sLit "f19";
                52 -> sLit "f20"; 53 -> sLit "f21";
                54 -> sLit "f22"; 55 -> sLit "f23";
                56 -> sLit "f24"; 57 -> sLit "f25";
                58 -> sLit "f26"; 59 -> sLit "f27";
                60 -> sLit "f28"; 61 -> sLit "f29";
                62 -> sLit "f30"; 63 -> sLit "f31";
                _  -> sLit "very naughty powerpc register"
              })
        _
         | i <= 31   -> int i      -- GPRs
         | i <= 63   -> int (i-32) -- FPRs
         | otherwise -> ptext (sLit "very naughty powerpc register")
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223



pprSize :: Size -> Doc
pprSize x 
 = ptext (case x of
		II8	-> sLit "b"
	        II16	-> sLit "h"
		II32	-> sLit "w"
		FF32	-> sLit "fs"
		FF64	-> sLit "fd"
		_	-> panic "PPC.Ppr.pprSize: no match")
		
		
pprCond :: Cond -> Doc
pprCond c 
 = ptext (case c of {
		ALWAYS  -> sLit "";
		EQQ	-> sLit "eq";	NE    -> sLit "ne";
		LTT     -> sLit "lt";  GE    -> sLit "ge";
		GTT     -> sLit "gt";  LE    -> sLit "le";
		LU      -> sLit "lt";  GEU   -> sLit "ge";
		GU      -> sLit "gt";  LEU   -> sLit "le"; })


224
pprImm :: Platform -> Imm -> Doc
225

226
227
228
229
230
pprImm _        (ImmInt i)     = int i
pprImm _        (ImmInteger i) = integer i
pprImm platform (ImmCLbl l)    = pprCLabel_asm platform l
pprImm platform (ImmIndex l i) = pprCLabel_asm platform l <> char '+' <> int i
pprImm _        (ImmLit s)     = s
231

232
233
pprImm _        (ImmFloat _)  = ptext (sLit "naughty float immediate")
pprImm _        (ImmDouble _) = ptext (sLit "naughty double immediate")
234

235
236
237
pprImm platform (ImmConstantSum a b) = pprImm platform a <> char '+' <> pprImm platform b
pprImm platform (ImmConstantDiff a b) = pprImm platform a <> char '-'
                            <> lparen <> pprImm platform b <> rparen
238

239
pprImm platform (LO i)
240
241
242
  = if platformOS platform == OSDarwin
    then hcat [ text "lo16(", pprImm platform i, rparen ]
    else pprImm platform i <> text "@l"
243

244
pprImm platform (HI i)
245
246
247
  = if platformOS platform == OSDarwin
    then hcat [ text "hi16(", pprImm platform i, rparen ]
    else pprImm platform i <> text "@h"
248

249
pprImm platform (HA i)
250
251
252
  = if platformOS platform == OSDarwin
    then hcat [ text "ha16(", pprImm platform i, rparen ]
    else pprImm platform i <> text "@ha"
253
254


255
pprAddr :: Platform -> AddrMode -> Doc
256
257
pprAddr platform (AddrRegReg r1 r2)
  = pprReg platform r1 <+> ptext (sLit ", ") <+> pprReg platform r2
258

259
260
261
pprAddr platform (AddrRegImm r1 (ImmInt i)) = hcat [ int i, char '(', pprReg platform r1, char ')' ]
pprAddr platform (AddrRegImm r1 (ImmInteger i)) = hcat [ integer i, char '(', pprReg platform r1, char ')' ]
pprAddr platform (AddrRegImm r1 imm) = hcat [ pprImm platform imm, char '(', pprReg platform r1, char ')' ]
262
263


264
265
pprSectionHeader :: Platform -> Section -> Doc
pprSectionHeader platform seg
266
 = case seg of
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
        Text                    -> ptext (sLit ".text\n.align 2")
        Data                    -> ptext (sLit ".data\n.align 2")
        ReadOnlyData
         | osDarwin             -> ptext (sLit ".const\n.align 2")
         | otherwise            -> ptext (sLit ".section .rodata\n\t.align 2")
        RelocatableReadOnlyData
         | osDarwin             -> ptext (sLit ".const_data\n.align 2")
         | otherwise            -> ptext (sLit ".data\n\t.align 2")
        UninitialisedData
         | osDarwin             -> ptext (sLit ".const_data\n.align 2")
         | otherwise            -> ptext (sLit ".section .bss\n\t.align 2")
        ReadOnlyData16
         | osDarwin             -> ptext (sLit ".const\n.align 4")
         | otherwise            -> ptext (sLit ".section .rodata\n\t.align 4")
        OtherSection _          ->
            panic "PprMach.pprSectionHeader: unknown section"
    where osDarwin = platformOS platform == OSDarwin
284
285


286
287
pprDataItem :: Platform -> CmmLit -> Doc
pprDataItem platform lit
288
289
290
291
  = vcat (ppr_item (cmmTypeSize $ cmmLitType lit) lit)
    where
	imm = litToImm lit

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
297

	ppr_item FF32 (CmmFloat r _)
           = let bs = floatToBytes (fromRational r)
298
             in  map (\b -> ptext (sLit "\t.byte\t") <> pprImm platform (ImmInt b)) bs
299
300
301

    	ppr_item FF64 (CmmFloat r _)
           = 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
307
308
309
310
311
312
313
314
315
316

        ppr_item II64 (CmmInt x _)  =
                [ptext (sLit "\t.long\t")
                    <> int (fromIntegral 
                        (fromIntegral (x `shiftR` 32) :: Word32)),
                 ptext (sLit "\t.long\t")
                    <> int (fromIntegral (fromIntegral x :: Word32))]

	ppr_item _ _
		= panic "PPC.Ppr.pprDataItem: no match"


317
pprInstr :: Platform -> Instr -> Doc
318

319
pprInstr _ (COMMENT _) = empty -- nuke 'em
320
{-
321
322
323
324
pprInstr platform (COMMENT s) =
     if platformOS platform == OSLinux
     then ptext (sLit "# ") <> ftext s
     else ptext (sLit "; ") <> ftext s
325
-}
326
327
pprInstr platform (DELTA d)
   = pprInstr platform (COMMENT (mkFastString ("\tdelta = " ++ show d)))
328

329
pprInstr _ (NEWBLOCK _)
330
331
   = panic "PprMach.pprInstr: NEWBLOCK"

332
pprInstr _ (LDATA _ _)
333
334
   = panic "PprMach.pprInstr: LDATA"

335
{-
336
pprInstr _ (SPILL reg slot)
337
338
339
   = hcat [
   	ptext (sLit "\tSPILL"),
	char '\t',
340
	pprReg platform reg,
341
342
343
	comma,
	ptext (sLit "SLOT") <> parens (int slot)]

344
pprInstr _ (RELOAD slot reg)
345
346
347
348
349
   = hcat [
   	ptext (sLit "\tRELOAD"),
	char '\t',
	ptext (sLit "SLOT") <> parens (int slot),
	comma,
350
	pprReg platform reg]
351
-}
352

353
pprInstr platform (LD sz reg addr) = hcat [
354
355
356
357
358
359
360
361
362
363
364
365
366
	char '\t',
	ptext (sLit "l"),
	ptext (case sz of
	    II8  -> sLit "bz"
	    II16 -> sLit "hz"
	    II32 -> sLit "wz"
	    FF32 -> sLit "fs"
	    FF64 -> sLit "fd"
	    _	 -> panic "PPC.Ppr.pprInstr: no match"
	    ),
        case addr of AddrRegImm _ _ -> empty
                     AddrRegReg _ _ -> char 'x',
	char '\t',
367
	pprReg platform reg,
368
	ptext (sLit ", "),
369
	pprAddr platform addr
370
    ]
371
pprInstr platform (LA sz reg addr) = hcat [
372
373
374
375
376
377
378
379
380
381
382
383
384
	char '\t',
	ptext (sLit "l"),
	ptext (case sz of
	    II8  -> sLit "ba"
	    II16 -> sLit "ha"
	    II32 -> sLit "wa"
	    FF32 -> sLit "fs"
	    FF64 -> sLit "fd"
	    _	 -> panic "PPC.Ppr.pprInstr: no match"
	    ),
        case addr of AddrRegImm _ _ -> empty
                     AddrRegReg _ _ -> char 'x',
	char '\t',
385
	pprReg platform reg,
386
	ptext (sLit ", "),
387
	pprAddr platform addr
388
    ]
389
pprInstr platform (ST sz reg addr) = hcat [
390
391
392
393
394
395
	char '\t',
	ptext (sLit "st"),
	pprSize sz,
        case addr of AddrRegImm _ _ -> empty
                     AddrRegReg _ _ -> char 'x',
	char '\t',
396
	pprReg platform reg,
397
	ptext (sLit ", "),
398
	pprAddr platform addr
399
    ]
400
pprInstr platform (STU sz reg addr) = hcat [
401
402
403
404
405
406
	char '\t',
	ptext (sLit "st"),
	pprSize sz,
	ptext (sLit "u\t"),
        case addr of AddrRegImm _ _ -> empty
                     AddrRegReg _ _ -> char 'x',
407
	pprReg platform reg,
408
	ptext (sLit ", "),
409
	pprAddr platform addr
410
    ]
411
pprInstr platform (LIS reg imm) = hcat [
412
413
414
	char '\t',
	ptext (sLit "lis"),
	char '\t',
415
	pprReg platform reg,
416
	ptext (sLit ", "),
417
	pprImm platform imm
418
    ]
419
pprInstr platform (LI reg imm) = hcat [
420
421
422
	char '\t',
	ptext (sLit "li"),
	char '\t',
423
	pprReg platform reg,
424
	ptext (sLit ", "),
425
	pprImm platform imm
426
    ]
427
pprInstr platform (MR reg1 reg2) 
428
429
430
    | reg1 == reg2 = empty
    | otherwise = hcat [
	char '\t',
431
	case targetClassOfReg platform reg1 of
432
433
434
	    RcInteger -> ptext (sLit "mr")
	    _ -> ptext (sLit "fmr"),
	char '\t',
435
	pprReg platform reg1,
436
	ptext (sLit ", "),
437
	pprReg platform reg2
438
    ]
439
pprInstr platform (CMP sz reg ri) = hcat [
440
441
442
	char '\t',
	op,
	char '\t',
443
	pprReg platform reg,
444
	ptext (sLit ", "),
445
	pprRI platform ri
446
447
448
449
450
451
452
453
454
    ]
    where
	op = hcat [
		ptext (sLit "cmp"),
		pprSize sz,
		case ri of
		    RIReg _ -> empty
		    RIImm _ -> char 'i'
	    ]
455
pprInstr platform (CMPL sz reg ri) = hcat [
456
457
458
	char '\t',
	op,
	char '\t',
459
	pprReg platform reg,
460
	ptext (sLit ", "),
461
	pprRI platform ri
462
463
464
465
466
467
468
469
470
    ]
    where
	op = hcat [
		ptext (sLit "cmpl"),
		pprSize sz,
		case ri of
		    RIReg _ -> empty
		    RIImm _ -> char 'i'
	    ]
471
pprInstr platform (BCC cond blockid) = hcat [
472
473
474
475
	char '\t',
	ptext (sLit "b"),
	pprCond cond,
	char '\t',
476
	pprCLabel_asm platform lbl
477
    ]
478
    where lbl = mkAsmTempLabel (getUnique blockid)
479

480
pprInstr platform (BCCFAR cond blockid) = vcat [
481
482
483
484
485
486
487
        hcat [
            ptext (sLit "\tb"),
            pprCond (condNegate cond),
            ptext (sLit "\t$+8")
        ],
        hcat [
            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
495
496
	char '\t',
	ptext (sLit "b"),
	char '\t',
497
	pprCLabel_asm platform lbl
498
499
    ]

500
pprInstr platform (MTCTR reg) = hcat [
501
502
503
	char '\t',
	ptext (sLit "mtctr"),
	char '\t',
504
	pprReg platform reg
505
    ]
506
pprInstr _ (BCTR _ _) = hcat [
507
508
509
	char '\t',
	ptext (sLit "bctr")
    ]
510
pprInstr platform (BL lbl _) = hcat [
511
	ptext (sLit "\tbl\t"),
512
        pprCLabel_asm platform lbl
513
    ]
514
pprInstr _ (BCTRL _) = hcat [
515
516
517
	char '\t',
	ptext (sLit "bctrl")
    ]
518
519
pprInstr platform (ADD reg1 reg2 ri) = pprLogic platform (sLit "add") reg1 reg2 ri
pprInstr platform (ADDIS reg1 reg2 imm) = hcat [
520
521
522
	char '\t',
	ptext (sLit "addis"),
	char '\t',
523
	pprReg platform reg1,
524
	ptext (sLit ", "),
525
	pprReg platform reg2,
526
	ptext (sLit ", "),
527
	pprImm platform imm
528
529
    ]

530
531
532
533
534
535
536
pprInstr platform (ADDC reg1 reg2 reg3) = pprLogic platform (sLit "addc") reg1 reg2 (RIReg reg3)
pprInstr platform (ADDE reg1 reg2 reg3) = pprLogic platform (sLit "adde") reg1 reg2 (RIReg reg3)
pprInstr platform (SUBF reg1 reg2 reg3) = pprLogic platform (sLit "subf") reg1 reg2 (RIReg reg3)
pprInstr platform (MULLW reg1 reg2 ri@(RIReg _)) = pprLogic platform (sLit "mullw") reg1 reg2 ri
pprInstr platform (MULLW reg1 reg2 ri@(RIImm _)) = pprLogic platform (sLit "mull") reg1 reg2 ri
pprInstr platform (DIVW reg1 reg2 reg3) = pprLogic platform (sLit "divw") reg1 reg2 (RIReg reg3)
pprInstr platform (DIVWU reg1 reg2 reg3) = pprLogic platform (sLit "divwu") reg1 reg2 (RIReg reg3)
537

538
539
540
541
542
543
544
pprInstr platform (MULLW_MayOflo reg1 reg2 reg3) = vcat [
         hcat [ ptext (sLit "\tmullwo\t"), pprReg platform reg1, ptext (sLit ", "),
                                          pprReg platform reg2, ptext (sLit ", "),
                                          pprReg platform reg3 ],
         hcat [ ptext (sLit "\tmfxer\t"),  pprReg platform reg1 ],
         hcat [ ptext (sLit "\trlwinm\t"), pprReg platform reg1, ptext (sLit ", "),
                                          pprReg platform reg1, ptext (sLit ", "),
545
546
547
548
549
                                          ptext (sLit "2, 31, 31") ]
    ]

    	-- for some reason, "andi" doesn't exist.
	-- we'll use "andi." instead.
550
pprInstr platform (AND reg1 reg2 (RIImm imm)) = hcat [
551
552
553
	char '\t',
	ptext (sLit "andi."),
	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
563
pprInstr platform (OR reg1 reg2 ri) = pprLogic platform (sLit "or") reg1 reg2 ri
pprInstr platform (XOR reg1 reg2 ri) = pprLogic platform (sLit "xor") reg1 reg2 ri
564

565
pprInstr platform (XORIS reg1 reg2 imm) = hcat [
566
567
568
	char '\t',
	ptext (sLit "xoris"),
	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
578
579
580
	char '\t',
	ptext (sLit "exts"),
	pprSize sz,
	char '\t',
581
	pprReg platform reg1,
582
	ptext (sLit ", "),
583
	pprReg platform reg2
584
585
    ]

586
587
pprInstr platform (NEG reg1 reg2) = pprUnary platform (sLit "neg") reg1 reg2
pprInstr platform (NOT reg1 reg2) = pprUnary platform (sLit "not") reg1 reg2
588

589
590
591
pprInstr platform (SLW reg1 reg2 ri) = pprLogic platform (sLit "slw") reg1 reg2 (limitShiftRI ri)
pprInstr platform (SRW reg1 reg2 ri) = pprLogic platform (sLit "srw") reg1 reg2 (limitShiftRI ri)
pprInstr platform (SRAW reg1 reg2 ri) = pprLogic platform (sLit "sraw") reg1 reg2 (limitShiftRI ri)
592
pprInstr platform (RLWINM reg1 reg2 sh mb me) = hcat [
593
        ptext (sLit "\trlwinm\t"),
594
        pprReg platform reg1,
595
        ptext (sLit ", "),
596
        pprReg platform reg2,
597
598
599
600
601
602
603
604
        ptext (sLit ", "),
        int sh,
        ptext (sLit ", "),
        int mb,
        ptext (sLit ", "),
        int me
    ]
    
605
606
607
608
609
pprInstr platform (FADD sz reg1 reg2 reg3) = pprBinaryF platform (sLit "fadd") sz reg1 reg2 reg3
pprInstr platform (FSUB sz reg1 reg2 reg3) = pprBinaryF platform (sLit "fsub") sz reg1 reg2 reg3
pprInstr platform (FMUL sz reg1 reg2 reg3) = pprBinaryF platform (sLit "fmul") sz reg1 reg2 reg3
pprInstr platform (FDIV sz reg1 reg2 reg3) = pprBinaryF platform (sLit "fdiv") sz reg1 reg2 reg3
pprInstr platform (FNEG reg1 reg2) = pprUnary platform (sLit "fneg") reg1 reg2
610

611
pprInstr platform (FCMP reg1 reg2) = hcat [
612
613
614
615
616
	char '\t',
	ptext (sLit "fcmpu\tcr0, "),
	    -- Note: we're using fcmpu, not fcmpo
	    -- The difference is with fcmpo, compare with NaN is an invalid operation.
	    -- We don't handle invalid fp ops, so we don't care
617
	pprReg platform reg1,
618
	ptext (sLit ", "),
619
	pprReg platform reg2
620
621
    ]

622
623
pprInstr platform (FCTIWZ reg1 reg2) = pprUnary platform (sLit "fctiwz") reg1 reg2
pprInstr platform (FRSP reg1 reg2) = pprUnary platform (sLit "frsp") reg1 reg2
624

625
pprInstr _ (CRNOR dst src1 src2) = hcat [
626
627
628
629
630
631
632
633
        ptext (sLit "\tcrnor\t"),
        int dst,
        ptext (sLit ", "),
        int src1,
        ptext (sLit ", "),
        int src2
    ]

634
pprInstr platform (MFCR reg) = hcat [
635
636
637
	char '\t',
	ptext (sLit "mfcr"),
	char '\t',
638
	pprReg platform reg
639
640
    ]

641
pprInstr platform (MFLR reg) = hcat [
642
643
644
	char '\t',
	ptext (sLit "mflr"),
	char '\t',
645
	pprReg platform reg
646
647
    ]

648
pprInstr platform (FETCHPC reg) = vcat [
649
        ptext (sLit "\tbcl\t20,31,1f"),
650
        hcat [ ptext (sLit "1:\tmflr\t"), pprReg platform reg ]
651
652
    ]

653
pprInstr _ LWSYNC = ptext (sLit "\tlwsync")
654

655
-- pprInstr _ _ = panic "pprInstr (ppc)"
656
657


658
659
pprLogic :: Platform -> LitString -> Reg -> Reg -> RI -> Doc
pprLogic platform op reg1 reg2 ri = hcat [
660
661
662
663
664
665
	char '\t',
	ptext op,
	case ri of
	    RIReg _ -> empty
	    RIImm _ -> char 'i',
	char '\t',
666
	pprReg platform reg1,
667
	ptext (sLit ", "),
668
	pprReg platform reg2,
669
	ptext (sLit ", "),
670
	pprRI platform ri
671
672
673
    ]


674
675
pprUnary :: Platform -> LitString -> Reg -> Reg -> Doc
pprUnary platform op reg1 reg2 = hcat [
676
677
678
	char '\t',
	ptext op,
	char '\t',
679
	pprReg platform reg1,
680
	ptext (sLit ", "),
681
	pprReg platform reg2
682
683
684
    ]
    
    
685
686
pprBinaryF :: Platform -> LitString -> Size -> Reg -> Reg -> Reg -> Doc
pprBinaryF platform op sz reg1 reg2 reg3 = hcat [
687
688
689
690
	char '\t',
	ptext op,
	pprFSize sz,
	char '\t',
691
	pprReg platform reg1,
692
	ptext (sLit ", "),
693
	pprReg platform reg2,
694
	ptext (sLit ", "),
695
	pprReg platform reg3
696
697
    ]
    
698
pprRI :: Platform -> RI -> Doc
699
pprRI platform (RIReg r) = pprReg platform r
700
pprRI platform (RIImm r) = pprImm platform r
701
702
703
704
705
706
707
708
709
710
711
712
713


pprFSize :: Size -> Doc
pprFSize FF64	= empty
pprFSize FF32	= char 's'
pprFSize _	= panic "PPC.Ppr.pprFSize: no match"

    -- limit immediate argument for shift instruction to range 0..32
    -- (yes, the maximum is really 32, not 31)
limitShiftRI :: RI -> RI
limitShiftRI (RIImm (ImmInt i)) | i > 32 || i < 0 = RIImm (ImmInt 32)
limitShiftRI x = x