-----------------------------------------------------------------------------
--
-- Pretty-printing assembly language
--
-- (c) The University of Glasgow 1993-2005
--
-----------------------------------------------------------------------------

{-# OPTIONS_GHC -fno-warn-orphans #-}
module PPC.Ppr (pprNatCmmDecl) where

import GhcPrelude

import PPC.Regs
import PPC.Instr
import PPC.Cond
import PprBase
import Instruction
import Format
import Reg
import RegClass
import TargetReg

import Cmm hiding (topInfoTable)
import Hoopl.Collections
import Hoopl.Label

import BlockId
import CLabel

import Unique                ( pprUniqueAlways, getUnique )
import Platform
import FastString
import Outputable
import DynFlags

import Data.Word
import Data.Int
import Data.Bits

-- -----------------------------------------------------------------------------
-- Printing this stuff out

pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
pprNatCmmDecl :: NatCmmDecl CmmStatics Instr -> SDoc
pprNatCmmDecl (CmmData section :: Section
section dats :: CmmStatics
dats) =
  Section -> SDoc
pprSectionAlign Section
section SDoc -> SDoc -> SDoc
$$ CmmStatics -> SDoc
pprDatas CmmStatics
dats

pprNatCmmDecl proc :: NatCmmDecl CmmStatics Instr
proc@(CmmProc top_info :: LabelMap CmmStatics
top_info lbl :: CLabel
lbl _ (ListGraph blocks :: [GenBasicBlock Instr]
blocks)) =
  case NatCmmDecl CmmStatics Instr -> Maybe CmmStatics
forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable NatCmmDecl CmmStatics Instr
proc of
    Nothing ->
       (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
       case [GenBasicBlock Instr]
blocks of
         []     -> -- special case for split markers:
           CLabel -> SDoc
pprLabel CLabel
lbl
         blocks :: [GenBasicBlock Instr]
blocks -> -- special case for code without info table:
           Section -> SDoc
pprSectionAlign (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
lbl) SDoc -> SDoc -> SDoc
$$
           (case Platform -> Arch
platformArch Platform
platform of
              ArchPPC_64 ELF_V1 -> CLabel -> SDoc
pprFunctionDescriptor CLabel
lbl
              ArchPPC_64 ELF_V2 -> CLabel -> SDoc
pprFunctionPrologue CLabel
lbl
              _ -> CLabel -> SDoc
pprLabel CLabel
lbl) SDoc -> SDoc -> SDoc
$$ -- blocks guaranteed not null,
                                     -- so label needed
           [SDoc] -> SDoc
vcat ((GenBasicBlock Instr -> SDoc) -> [GenBasicBlock Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (LabelMap CmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock LabelMap CmmStatics
top_info) [GenBasicBlock Instr]
blocks)

    Just (Statics info_lbl :: CLabel
info_lbl _) ->
      (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
      Section -> SDoc
pprSectionAlign (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
info_lbl) SDoc -> SDoc -> SDoc
$$
      (if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
          then CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':'
          else SDoc
empty) SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
vcat ((GenBasicBlock Instr -> SDoc) -> [GenBasicBlock Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (LabelMap CmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock LabelMap CmmStatics
top_info) [GenBasicBlock Instr]
blocks) SDoc -> SDoc -> SDoc
$$
      -- above: Even the first block gets a label, because with branch-chain
      -- elimination, it might be the target of a goto.
      (if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
       then
       -- See Note [Subsections Via Symbols] in X86/Ppr.hs
                String -> SDoc
text "\t.long "
            SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
info_lbl
            SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char '-'
            SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl)
       else SDoc
empty)

pprFunctionDescriptor :: CLabel -> SDoc
pprFunctionDescriptor :: CLabel -> SDoc
pprFunctionDescriptor lab :: CLabel
lab = CLabel -> SDoc
pprGloblDecl CLabel
lab
                        SDoc -> SDoc -> SDoc
$$  String -> SDoc
text "\t.section \".opd\", \"aw\""
                        SDoc -> SDoc -> SDoc
$$  String -> SDoc
text "\t.align 3"
                        SDoc -> SDoc -> SDoc
$$  CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':'
                        SDoc -> SDoc -> SDoc
$$  String -> SDoc
text "\t.quad ."
                        SDoc -> SDoc -> SDoc
<>  CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab
                        SDoc -> SDoc -> SDoc
<>  String -> SDoc
text ",.TOC.@tocbase,0"
                        SDoc -> SDoc -> SDoc
$$  String -> SDoc
text "\t.previous"
                        SDoc -> SDoc -> SDoc
$$  String -> SDoc
text "\t.type"
                        SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab
                        SDoc -> SDoc -> SDoc
<>  String -> SDoc
text ", @function"
                        SDoc -> SDoc -> SDoc
$$  Char -> SDoc
char '.' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':'

pprFunctionPrologue :: CLabel ->SDoc
pprFunctionPrologue :: CLabel -> SDoc
pprFunctionPrologue lab :: CLabel
lab =  CLabel -> SDoc
pprGloblDecl CLabel
lab
                        SDoc -> SDoc -> SDoc
$$  String -> SDoc
text ".type "
                        SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab
                        SDoc -> SDoc -> SDoc
<> String -> SDoc
text ", @function"
                        SDoc -> SDoc -> SDoc
$$ CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':'
                        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "0:\taddis\t" SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pprReg Reg
toc
                        SDoc -> SDoc -> SDoc
<> String -> SDoc
text ",12,.TOC.-0b@ha"
                        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "\taddi\t" SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pprReg Reg
toc
                        SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ',' SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pprReg Reg
toc SDoc -> SDoc -> SDoc
<> String -> SDoc
text ",.TOC.-0b@l"
                        SDoc -> SDoc -> SDoc
$$ String -> SDoc
text "\t.localentry\t" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab
                        SDoc -> SDoc -> SDoc
<> String -> SDoc
text ",.-" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab

pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
pprBasicBlock :: LabelMap CmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock info_env :: LabelMap CmmStatics
info_env (BasicBlock blockid :: BlockId
blockid instrs :: [Instr]
instrs)
  = SDoc
maybe_infotable SDoc -> SDoc -> SDoc
$$
    CLabel -> SDoc
pprLabel (BlockId -> CLabel
blockLbl BlockId
blockid) SDoc -> SDoc -> SDoc
$$
    [SDoc] -> SDoc
vcat ((Instr -> SDoc) -> [Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Instr -> SDoc
pprInstr [Instr]
instrs)
  where
    maybe_infotable :: SDoc
maybe_infotable = case KeyOf LabelMap -> LabelMap CmmStatics -> Maybe CmmStatics
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
blockid LabelMap CmmStatics
info_env of
       Nothing   -> SDoc
empty
       Just (Statics info_lbl :: CLabel
info_lbl info :: [CmmStatic]
info) ->
           SectionType -> SDoc
pprAlignForSection SectionType
Text SDoc -> SDoc -> SDoc
$$
           [SDoc] -> SDoc
vcat ((CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CmmStatic -> SDoc
pprData [CmmStatic]
info) SDoc -> SDoc -> SDoc
$$
           CLabel -> SDoc
pprLabel CLabel
info_lbl



pprDatas :: CmmStatics -> SDoc
pprDatas :: CmmStatics -> SDoc
pprDatas (Statics lbl :: CLabel
lbl dats :: [CmmStatic]
dats) = [SDoc] -> SDoc
vcat (CLabel -> SDoc
pprLabel CLabel
lbl SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CmmStatic -> SDoc
pprData [CmmStatic]
dats)

pprData :: CmmStatic -> SDoc
pprData :: CmmStatic -> SDoc
pprData (CmmString str :: [Word8]
str)
  = String -> SDoc
text "\t.string" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
doubleQuotes ([Word8] -> SDoc
pprASCII [Word8]
str)
pprData (CmmUninitialised bytes :: Int
bytes) = String -> SDoc
text ".space " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
bytes
pprData (CmmStaticLit lit :: CmmLit
lit)       = CmmLit -> SDoc
pprDataItem CmmLit
lit

pprGloblDecl :: CLabel -> SDoc
pprGloblDecl :: CLabel -> SDoc
pprGloblDecl lbl :: CLabel
lbl
  | Bool -> Bool
not (CLabel -> Bool
externallyVisibleCLabel CLabel
lbl) = SDoc
empty
  | Bool
otherwise = String -> SDoc
text ".globl " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl

pprTypeAndSizeDecl :: CLabel -> SDoc
pprTypeAndSizeDecl :: CLabel -> SDoc
pprTypeAndSizeDecl lbl :: CLabel
lbl
  = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
    if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSLinux Bool -> Bool -> Bool
&& CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
    then String -> SDoc
text ".type " SDoc -> SDoc -> SDoc
<>
         CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text ", @object"
    else SDoc
empty

pprLabel :: CLabel -> SDoc
pprLabel :: CLabel -> SDoc
pprLabel lbl :: CLabel
lbl = CLabel -> SDoc
pprGloblDecl CLabel
lbl
            SDoc -> SDoc -> SDoc
$$ CLabel -> SDoc
pprTypeAndSizeDecl CLabel
lbl
            SDoc -> SDoc -> SDoc
$$ (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ':')

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

instance Outputable Instr where
    ppr :: Instr -> SDoc
ppr instr :: Instr
instr = Instr -> SDoc
pprInstr Instr
instr


pprReg :: Reg -> SDoc

pprReg :: Reg -> SDoc
pprReg r :: Reg
r
  = case Reg
r of
      RegReal    (RealRegSingle i :: Int
i) -> Int -> SDoc
ppr_reg_no Int
i
      RegReal    (RealRegPair{})   -> String -> SDoc
forall a. String -> a
panic "PPC.pprReg: no reg pairs on this arch"
      RegVirtual (VirtualRegI  u :: Unique
u)  -> String -> SDoc
text "%vI_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegHi u :: Unique
u)  -> String -> SDoc
text "%vHi_"  SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegF  u :: Unique
u)  -> String -> SDoc
text "%vF_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegD  u :: Unique
u)  -> String -> SDoc
text "%vD_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegSSE u :: Unique
u) -> String -> SDoc
text "%vSSE_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
  where
    ppr_reg_no :: Int -> SDoc
    ppr_reg_no :: Int -> SDoc
ppr_reg_no i :: Int
i
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 31   = Int -> SDoc
int Int
i      -- GPRs
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 63   = Int -> SDoc
int (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-32) -- FPRs
         | Bool
otherwise = String -> SDoc
text "very naughty powerpc register"



pprFormat :: Format -> SDoc
pprFormat :: Format -> SDoc
pprFormat x :: Format
x
 = PtrString -> SDoc
ptext (case Format
x of
                II8  -> String -> PtrString
sLit "b"
                II16 -> String -> PtrString
sLit "h"
                II32 -> String -> PtrString
sLit "w"
                II64 -> String -> PtrString
sLit "d"
                FF32 -> String -> PtrString
sLit "fs"
                FF64 -> String -> PtrString
sLit "fd"
                _    -> String -> PtrString
forall a. String -> a
panic "PPC.Ppr.pprFormat: no match")


pprCond :: Cond -> SDoc
pprCond :: Cond -> SDoc
pprCond c :: Cond
c
 = PtrString -> SDoc
ptext (case Cond
c of {
                ALWAYS  -> String -> PtrString
sLit "";
                EQQ     -> String -> PtrString
sLit "eq";  NE    -> String -> PtrString
sLit "ne";
                LTT     -> String -> PtrString
sLit "lt";  GE    -> String -> PtrString
sLit "ge";
                GTT     -> String -> PtrString
sLit "gt";  LE    -> String -> PtrString
sLit "le";
                LU      -> String -> PtrString
sLit "lt";  GEU   -> String -> PtrString
sLit "ge";
                GU      -> String -> PtrString
sLit "gt";  LEU   -> String -> PtrString
sLit "le"; })


pprImm :: Imm -> SDoc

pprImm :: Imm -> SDoc
pprImm (ImmInt i :: Int
i)     = Int -> SDoc
int Int
i
pprImm (ImmInteger i :: Integer
i) = Integer -> SDoc
integer Integer
i
pprImm (ImmCLbl l :: CLabel
l)    = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l
pprImm (ImmIndex l :: CLabel
l i :: Int
i) = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '+' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i
pprImm (ImmLit s :: SDoc
s)     = SDoc
s

pprImm (ImmFloat _)  = String -> SDoc
text "naughty float immediate"
pprImm (ImmDouble _) = String -> SDoc
text "naughty double immediate"

pprImm (ImmConstantSum a :: Imm
a b :: Imm
b) = Imm -> SDoc
pprImm Imm
a SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '+' SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
b
pprImm (ImmConstantDiff a :: Imm
a b :: Imm
b) = Imm -> SDoc
pprImm Imm
a SDoc -> SDoc -> SDoc
<> Char -> SDoc
char '-'
                   SDoc -> SDoc -> SDoc
<> SDoc
lparen SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
b SDoc -> SDoc -> SDoc
<> SDoc
rparen

pprImm (LO (ImmInt i :: Int
i))     = Imm -> SDoc
pprImm (Imm -> Imm
LO (Integer -> Imm
ImmInteger (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i)))
pprImm (LO (ImmInteger i :: Integer
i)) = Imm -> SDoc
pprImm (Integer -> Imm
ImmInteger (Int16 -> Integer
forall a. Integral a => a -> Integer
toInteger Int16
lo16))
  where
    lo16 :: Int16
lo16 = Integer -> Int16
forall a. Num a => Integer -> a
fromInteger (Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. 0xffff) :: Int16

pprImm (LO i :: Imm
i)
  = Imm -> SDoc
pprImm Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text "@l"

pprImm (HI i :: Imm
i)
  = Imm -> SDoc
pprImm Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text "@h"

pprImm (HA (ImmInt i :: Int
i))     = Imm -> SDoc
pprImm (Imm -> Imm
HA (Integer -> Imm
ImmInteger (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i)))
pprImm (HA (ImmInteger i :: Integer
i)) = Imm -> SDoc
pprImm (Integer -> Imm
ImmInteger Integer
ha16)
  where
    ha16 :: Integer
ha16 = if Integer
lo16 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= 0x8000 then Integer
hi16Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+1 else Integer
hi16
    hi16 :: Integer
hi16 = (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` 16)
    lo16 :: Integer
lo16 = Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. 0xffff

pprImm (HA i :: Imm
i)
  = Imm -> SDoc
pprImm Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text "@ha"

pprImm (HIGHERA i :: Imm
i)
  = Imm -> SDoc
pprImm Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text "@highera"

pprImm (HIGHESTA i :: Imm
i)
  = Imm -> SDoc
pprImm Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text "@highesta"


pprAddr :: AddrMode -> SDoc
pprAddr :: AddrMode -> SDoc
pprAddr (AddrRegReg r1 :: Reg
r1 r2 :: Reg
r2)
  = Reg -> SDoc
pprReg Reg
r1 SDoc -> SDoc -> SDoc
<> Char -> SDoc
char ',' SDoc -> SDoc -> SDoc
<+> Reg -> SDoc
pprReg Reg
r2
pprAddr (AddrRegImm r1 :: Reg
r1 (ImmInt i :: Int
i))
  = [SDoc] -> SDoc
hcat [ Int -> SDoc
int Int
i, Char -> SDoc
char '(', Reg -> SDoc
pprReg Reg
r1, Char -> SDoc
char ')' ]
pprAddr (AddrRegImm r1 :: Reg
r1 (ImmInteger i :: Integer
i))
  = [SDoc] -> SDoc
hcat [ Integer -> SDoc
integer Integer
i, Char -> SDoc
char '(', Reg -> SDoc
pprReg Reg
r1, Char -> SDoc
char ')' ]
pprAddr (AddrRegImm r1 :: Reg
r1 imm :: Imm
imm)
  = [SDoc] -> SDoc
hcat [ Imm -> SDoc
pprImm Imm
imm, Char -> SDoc
char '(', Reg -> SDoc
pprReg Reg
r1, Char -> SDoc
char ')' ]


pprSectionAlign :: Section -> SDoc
pprSectionAlign :: Section -> SDoc
pprSectionAlign sec :: Section
sec@(Section seg :: SectionType
seg _) =
 (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
   Platform -> Section -> SDoc
pprSectionHeader Platform
platform Section
sec SDoc -> SDoc -> SDoc
$$
   SectionType -> SDoc
pprAlignForSection SectionType
seg

-- | Print appropriate alignment for the given section type.
pprAlignForSection :: SectionType -> SDoc
pprAlignForSection :: SectionType -> SDoc
pprAlignForSection seg :: SectionType
seg =
 (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
 let ppc64 :: Bool
ppc64    = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit Platform
platform
 in PtrString -> SDoc
ptext (PtrString -> SDoc) -> PtrString -> SDoc
forall a b. (a -> b) -> a -> b
$ case SectionType
seg of
       Text              -> String -> PtrString
sLit ".align 2"
       Data
        | Bool
ppc64          -> String -> PtrString
sLit ".align 3"
        | Bool
otherwise      -> String -> PtrString
sLit ".align 2"
       ReadOnlyData
        | Bool
ppc64          -> String -> PtrString
sLit ".align 3"
        | Bool
otherwise      -> String -> PtrString
sLit ".align 2"
       RelocatableReadOnlyData
        | Bool
ppc64          -> String -> PtrString
sLit ".align 3"
        | Bool
otherwise      -> String -> PtrString
sLit ".align 2"
       UninitialisedData
        | Bool
ppc64          -> String -> PtrString
sLit ".align 3"
        | Bool
otherwise      -> String -> PtrString
sLit ".align 2"
       ReadOnlyData16    -> String -> PtrString
sLit ".align 4"
       -- TODO: This is copied from the ReadOnlyData case, but it can likely be
       -- made more efficient.
       CString
        | Bool
ppc64          -> String -> PtrString
sLit ".align 3"
        | Bool
otherwise      -> String -> PtrString
sLit ".align 2"
       OtherSection _    -> String -> PtrString
forall a. String -> a
panic "PprMach.pprSectionAlign: unknown section"

pprDataItem :: CmmLit -> SDoc
pprDataItem :: CmmLit -> SDoc
pprDataItem lit :: CmmLit
lit
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
    [SDoc] -> SDoc
vcat (Format -> CmmLit -> DynFlags -> [SDoc]
ppr_item (CmmType -> Format
cmmTypeFormat (CmmType -> Format) -> CmmType -> Format
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmLit -> CmmType
cmmLitType DynFlags
dflags CmmLit
lit) CmmLit
lit DynFlags
dflags)
    where
        imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
        archPPC_64 :: DynFlags -> Bool
archPPC_64 dflags :: DynFlags
dflags = Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Platform -> Bool
target32Bit (Platform -> Bool) -> Platform -> Bool
forall a b. (a -> b) -> a -> b
$ DynFlags -> Platform
targetPlatform DynFlags
dflags

        ppr_item :: Format -> CmmLit -> DynFlags -> [SDoc]
ppr_item II8   _ _ = [String -> SDoc
text "\t.byte\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]

        ppr_item II32  _ _ = [String -> SDoc
text "\t.long\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]

        ppr_item II64 _ dflags :: DynFlags
dflags
           | DynFlags -> Bool
archPPC_64 DynFlags
dflags = [String -> SDoc
text "\t.quad\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]


        ppr_item FF32 (CmmFloat r :: Rational
r _) _
           = let bs :: [Int]
bs = Float -> [Int]
floatToBytes (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
r)
             in  (Int -> SDoc) -> [Int] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\b :: Int
b -> String -> SDoc
text "\t.byte\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm (Int -> Imm
ImmInt Int
b)) [Int]
bs

        ppr_item FF64 (CmmFloat r :: Rational
r _) _
           = let bs :: [Int]
bs = Double -> [Int]
doubleToBytes (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)
             in  (Int -> SDoc) -> [Int] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\b :: Int
b -> String -> SDoc
text "\t.byte\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm (Int -> Imm
ImmInt Int
b)) [Int]
bs

        ppr_item II16 _ _      = [String -> SDoc
text "\t.short\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]

        ppr_item II64 (CmmInt x :: Integer
x _) dflags :: DynFlags
dflags
           | Bool -> Bool
not(DynFlags -> Bool
archPPC_64 DynFlags
dflags) =
                [String -> SDoc
text "\t.long\t"
                    SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
                        (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` 32) :: Word32)),
                 String -> SDoc
text "\t.long\t"
                    SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word32))]

        ppr_item _ _ _
                = String -> [SDoc]
forall a. String -> a
panic "PPC.Ppr.pprDataItem: no match"


pprInstr :: Instr -> SDoc

pprInstr :: Instr -> SDoc
pprInstr (COMMENT _) = SDoc
empty -- nuke 'em
{-
pprInstr (COMMENT s) =
     if platformOS platform == OSLinux
     then text "# " <> ftext s
     else text "; " <> ftext s
-}
pprInstr (DELTA d :: Int
d)
   = Instr -> SDoc
pprInstr (FastString -> Instr
COMMENT (String -> FastString
mkFastString ("\tdelta = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d)))

pprInstr (NEWBLOCK _)
   = String -> SDoc
forall a. String -> a
panic "PprMach.pprInstr: NEWBLOCK"

pprInstr (LDATA _ _)
   = String -> SDoc
forall a. String -> a
panic "PprMach.pprInstr: LDATA"

{-
pprInstr (SPILL reg slot)
   = hcat [
           text "\tSPILL",
        char '\t',
        pprReg reg,
        comma,
        text "SLOT" <> parens (int slot)]

pprInstr (RELOAD slot reg)
   = hcat [
           text "\tRELOAD",
        char '\t',
        text "SLOT" <> parens (int slot),
        comma,
        pprReg reg]
-}

pprInstr (LD fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "l",
        PtrString -> SDoc
ptext (case Format
fmt of
            II8  -> String -> PtrString
sLit "bz"
            II16 -> String -> PtrString
sLit "hz"
            II32 -> String -> PtrString
sLit "wz"
            II64 -> String -> PtrString
sLit "d"
            FF32 -> String -> PtrString
sLit "fs"
            FF64 -> String -> PtrString
sLit "fd"
            _         -> String -> PtrString
forall a. String -> a
panic "PPC.Ppr.pprInstr: no match"
            ),
        case AddrMode
addr of AddrRegImm _ _ -> SDoc
empty
                     AddrRegReg _ _ -> Char -> SDoc
char 'x',
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg,
        String -> SDoc
text ", ",
        AddrMode -> SDoc
pprAddr AddrMode
addr
    ]

pprInstr (LDFAR fmt :: Format
fmt reg :: Reg
reg (AddrRegImm source :: Reg
source off :: Imm
off)) =
   (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform -> [SDoc] -> SDoc
vcat [
         Instr -> SDoc
pprInstr (Reg -> Reg -> Imm -> Instr
ADDIS (Platform -> Reg
tmpReg Platform
platform) Reg
source (Imm -> Imm
HA Imm
off)),
         Instr -> SDoc
pprInstr (Format -> Reg -> AddrMode -> Instr
LD Format
fmt Reg
reg (Reg -> Imm -> AddrMode
AddrRegImm (Platform -> Reg
tmpReg Platform
platform) (Imm -> Imm
LO Imm
off)))
    ]
pprInstr (LDFAR _ _ _) =
   String -> SDoc
forall a. String -> a
panic "PPC.Ppr.pprInstr LDFAR: no match"

pprInstr (LDR fmt :: Format
fmt reg1 :: Reg
reg1 addr :: AddrMode
addr) = [SDoc] -> SDoc
hcat [
  String -> SDoc
text "\tl",
  case Format
fmt of
    II32 -> Char -> SDoc
char 'w'
    II64 -> Char -> SDoc
char 'd'
    _    -> String -> SDoc
forall a. String -> a
panic "PPC.Ppr.Instr LDR: no match",
  String -> SDoc
text "arx\t",
  Reg -> SDoc
pprReg Reg
reg1,
  String -> SDoc
text ", ",
  AddrMode -> SDoc
pprAddr AddrMode
addr
  ]

pprInstr (LA fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "l",
        PtrString -> SDoc
ptext (case Format
fmt of
            II8  -> String -> PtrString
sLit "ba"
            II16 -> String -> PtrString
sLit "ha"
            II32 -> String -> PtrString
sLit "wa"
            II64 -> String -> PtrString
sLit "d"
            FF32 -> String -> PtrString
sLit "fs"
            FF64 -> String -> PtrString
sLit "fd"
            _         -> String -> PtrString
forall a. String -> a
panic "PPC.Ppr.pprInstr: no match"
            ),
        case AddrMode
addr of AddrRegImm _ _ -> SDoc
empty
                     AddrRegReg _ _ -> Char -> SDoc
char 'x',
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg,
        String -> SDoc
text ", ",
        AddrMode -> SDoc
pprAddr AddrMode
addr
    ]
pprInstr (ST fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "st",
        Format -> SDoc
pprFormat Format
fmt,
        case AddrMode
addr of AddrRegImm _ _ -> SDoc
empty
                     AddrRegReg _ _ -> Char -> SDoc
char 'x',
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg,
        String -> SDoc
text ", ",
        AddrMode -> SDoc
pprAddr AddrMode
addr
    ]
pprInstr (STFAR fmt :: Format
fmt reg :: Reg
reg (AddrRegImm source :: Reg
source off :: Imm
off)) =
   (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform -> [SDoc] -> SDoc
vcat [
         Instr -> SDoc
pprInstr (Reg -> Reg -> Imm -> Instr
ADDIS (Platform -> Reg
tmpReg Platform
platform) Reg
source (Imm -> Imm
HA Imm
off)),
         Instr -> SDoc
pprInstr (Format -> Reg -> AddrMode -> Instr
ST Format
fmt Reg
reg (Reg -> Imm -> AddrMode
AddrRegImm (Platform -> Reg
tmpReg Platform
platform) (Imm -> Imm
LO Imm
off)))
    ]
pprInstr (STFAR _ _ _) =
   String -> SDoc
forall a. String -> a
panic "PPC.Ppr.pprInstr STFAR: no match"
pprInstr (STU fmt :: Format
fmt reg :: Reg
reg addr :: AddrMode
addr) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "st",
        Format -> SDoc
pprFormat Format
fmt,
        Char -> SDoc
char 'u',
        case AddrMode
addr of AddrRegImm _ _ -> SDoc
empty
                     AddrRegReg _ _ -> Char -> SDoc
char 'x',
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg,
        String -> SDoc
text ", ",
        AddrMode -> SDoc
pprAddr AddrMode
addr
    ]
pprInstr (STC fmt :: Format
fmt reg1 :: Reg
reg1 addr :: AddrMode
addr) = [SDoc] -> SDoc
hcat [
  String -> SDoc
text "\tst",
  case Format
fmt of
    II32 -> Char -> SDoc
char 'w'
    II64 -> Char -> SDoc
char 'd'
    _    -> String -> SDoc
forall a. String -> a
panic "PPC.Ppr.Instr STC: no match",
  String -> SDoc
text "cx.\t",
  Reg -> SDoc
pprReg Reg
reg1,
  String -> SDoc
text ", ",
  AddrMode -> SDoc
pprAddr AddrMode
addr
  ]
pprInstr (LIS reg :: Reg
reg imm :: Imm
imm) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "lis",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg,
        String -> SDoc
text ", ",
        Imm -> SDoc
pprImm Imm
imm
    ]
pprInstr (LI reg :: Reg
reg imm :: Imm
imm) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "li",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg,
        String -> SDoc
text ", ",
        Imm -> SDoc
pprImm Imm
imm
    ]
pprInstr (MR reg1 :: Reg
reg1 reg2 :: Reg
reg2)
    | Reg
reg1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg2 = SDoc
empty
    | Bool
otherwise = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform ->
        case Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
reg1 of
            RcInteger -> String -> SDoc
text "mr"
            _ -> String -> SDoc
text "fmr",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2
    ]
pprInstr (CMP fmt :: Format
fmt reg :: Reg
reg ri :: RI
ri) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        SDoc
op,
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg,
        String -> SDoc
text ", ",
        RI -> SDoc
pprRI RI
ri
    ]
    where
        op :: SDoc
op = [SDoc] -> SDoc
hcat [
                String -> SDoc
text "cmp",
                Format -> SDoc
pprFormat Format
fmt,
                case RI
ri of
                    RIReg _ -> SDoc
empty
                    RIImm _ -> Char -> SDoc
char 'i'
            ]
pprInstr (CMPL fmt :: Format
fmt reg :: Reg
reg ri :: RI
ri) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        SDoc
op,
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg,
        String -> SDoc
text ", ",
        RI -> SDoc
pprRI RI
ri
    ]
    where
        op :: SDoc
op = [SDoc] -> SDoc
hcat [
                String -> SDoc
text "cmpl",
                Format -> SDoc
pprFormat Format
fmt,
                case RI
ri of
                    RIReg _ -> SDoc
empty
                    RIImm _ -> Char -> SDoc
char 'i'
            ]
pprInstr (BCC cond :: Cond
cond blockid :: BlockId
blockid prediction :: Maybe Bool
prediction) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "b",
        Cond -> SDoc
pprCond Cond
cond,
        Maybe Bool -> SDoc
pprPrediction Maybe Bool
prediction,
        Char -> SDoc
char '\t',
        CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
    ]
    where lbl :: CLabel
lbl = Unique -> CLabel
mkLocalBlockLabel (BlockId -> Unique
forall a. Uniquable a => a -> Unique
getUnique BlockId
blockid)
          pprPrediction :: Maybe Bool -> SDoc
pprPrediction p :: Maybe Bool
p = case Maybe Bool
p of
            Nothing    -> SDoc
empty
            Just True  -> Char -> SDoc
char '+'
            Just False -> Char -> SDoc
char '-'

pprInstr (BCCFAR cond :: Cond
cond blockid :: BlockId
blockid prediction :: Maybe Bool
prediction) = [SDoc] -> SDoc
vcat [
        [SDoc] -> SDoc
hcat [
            String -> SDoc
text "\tb",
            Cond -> SDoc
pprCond (Cond -> Cond
condNegate Cond
cond),
            SDoc
neg_prediction,
            String -> SDoc
text "\t$+8"
        ],
        [SDoc] -> SDoc
hcat [
            String -> SDoc
text "\tb\t",
            CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
        ]
    ]
    where lbl :: CLabel
lbl = Unique -> CLabel
mkLocalBlockLabel (BlockId -> Unique
forall a. Uniquable a => a -> Unique
getUnique BlockId
blockid)
          neg_prediction :: SDoc
neg_prediction = case Maybe Bool
prediction of
            Nothing    -> SDoc
empty
            Just True  -> Char -> SDoc
char '-'
            Just False -> Char -> SDoc
char '+'

pprInstr (JMP lbl :: CLabel
lbl)
  -- We never jump to ForeignLabels; if we ever do, c.f. handling for "BL"
  | CLabel -> Bool
isForeignLabel CLabel
lbl = String -> SDoc
forall a. String -> a
panic "PPC.Ppr.pprInstr: JMP to ForeignLabel"
  | Bool
otherwise =
    [SDoc] -> SDoc
hcat [ -- an alias for b that takes a CLabel
        Char -> SDoc
char '\t',
        String -> SDoc
text "b",
        Char -> SDoc
char '\t',
        CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
    ]

pprInstr (MTCTR reg :: Reg
reg) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "mtctr",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg
    ]
pprInstr (BCTR _ _) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "bctr"
    ]
pprInstr (BL lbl :: CLabel
lbl _) = do
    (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \platform :: Platform
platform -> case Platform -> OS
platformOS Platform
platform of
        OSAIX ->
          -- On AIX, "printf" denotes a function-descriptor (for use
          -- by function pointers), whereas the actual entry-code
          -- address is denoted by the dot-prefixed ".printf" label.
          -- Moreover, the PPC NCG only ever emits a BL instruction
          -- for calling C ABI functions. Most of the time these calls
          -- originate from FFI imports and have a 'ForeignLabel',
          -- but when profiling the codegen inserts calls via
          -- 'emitRtsCallGen' which are 'CmmLabel's even though
          -- they'd technically be more like 'ForeignLabel's.
          [SDoc] -> SDoc
hcat [
            String -> SDoc
text "\tbl\t.",
            CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
          ]
        _ ->
          [SDoc] -> SDoc
hcat [
            String -> SDoc
text "\tbl\t",
            CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
          ]
pprInstr (BCTRL _) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "bctrl"
    ]
pprInstr (ADD reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "add") Reg
reg1 Reg
reg2 RI
ri
pprInstr (ADDIS reg1 :: Reg
reg1 reg2 :: Reg
reg2 imm :: Imm
imm) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "addis",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Imm -> SDoc
pprImm Imm
imm
    ]

pprInstr (ADDO reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "addo") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
pprInstr (ADDC reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "addc") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
pprInstr (ADDE reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "adde") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
pprInstr (ADDZE reg1 :: Reg
reg1 reg2 :: Reg
reg2) = PtrString -> Reg -> Reg -> SDoc
pprUnary (String -> PtrString
sLit "addze") Reg
reg1 Reg
reg2
pprInstr (SUBF reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "subf") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
pprInstr (SUBFO reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "subfo") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
pprInstr (SUBFC reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "subf",
        case RI
ri of
            RIReg _ -> SDoc
empty
            RIImm _ -> Char -> SDoc
char 'i',
        String -> SDoc
text "c\t",
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        RI -> SDoc
pprRI RI
ri
    ]
pprInstr (SUBFE reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "subfe") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
pprInstr (MULL fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri) = Format -> Reg -> Reg -> RI -> SDoc
pprMul Format
fmt Reg
reg1 Reg
reg2 RI
ri
pprInstr (MULLO fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "mull",
        case Format
fmt of
          II32 -> Char -> SDoc
char 'w'
          II64 -> Char -> SDoc
char 'd'
          _    -> String -> SDoc
forall a. String -> a
panic "PPC: illegal format",
        String -> SDoc
text "o\t",
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg3
    ]
pprInstr (MFOV fmt :: Format
fmt reg :: Reg
reg) = [SDoc] -> SDoc
vcat [
        [SDoc] -> SDoc
hcat [
            Char -> SDoc
char '\t',
            String -> SDoc
text "mfxer",
            Char -> SDoc
char '\t',
            Reg -> SDoc
pprReg Reg
reg
            ],
        [SDoc] -> SDoc
hcat [
            Char -> SDoc
char '\t',
            String -> SDoc
text "extr",
            case Format
fmt of
              II32 -> Char -> SDoc
char 'w'
              II64 -> Char -> SDoc
char 'd'
              _    -> String -> SDoc
forall a. String -> a
panic "PPC: illegal format",
            String -> SDoc
text "i\t",
            Reg -> SDoc
pprReg Reg
reg,
            String -> SDoc
text ", ",
            Reg -> SDoc
pprReg Reg
reg,
            String -> SDoc
text ", 1, ",
            case Format
fmt of
              II32 -> String -> SDoc
text "1"
              II64 -> String -> SDoc
text "33"
              _    -> String -> SDoc
forall a. String -> a
panic "PPC: illegal format"
            ]
        ]

pprInstr (MULHU fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "mulh",
        case Format
fmt of
          II32 -> Char -> SDoc
char 'w'
          II64 -> Char -> SDoc
char 'd'
          _    -> String -> SDoc
forall a. String -> a
panic "PPC: illegal format",
        String -> SDoc
text "u\t",
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg3
    ]

pprInstr (DIV fmt :: Format
fmt sgn :: Bool
sgn reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = Format -> Bool -> Reg -> Reg -> Reg -> SDoc
pprDiv Format
fmt Bool
sgn Reg
reg1 Reg
reg2 Reg
reg3

        -- for some reason, "andi" doesn't exist.
        -- we'll use "andi." instead.
pprInstr (AND reg1 :: Reg
reg1 reg2 :: Reg
reg2 (RIImm imm :: Imm
imm)) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "andi.",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Imm -> SDoc
pprImm Imm
imm
    ]
pprInstr (AND reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "and") Reg
reg1 Reg
reg2 RI
ri
pprInstr (ANDC reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "andc") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
pprInstr (NAND reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "nand") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)

pprInstr (OR reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "or") Reg
reg1 Reg
reg2 RI
ri
pprInstr (XOR reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri) = PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit "xor") Reg
reg1 Reg
reg2 RI
ri

pprInstr (ORIS reg1 :: Reg
reg1 reg2 :: Reg
reg2 imm :: Imm
imm) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "oris",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Imm -> SDoc
pprImm Imm
imm
    ]

pprInstr (XORIS reg1 :: Reg
reg1 reg2 :: Reg
reg2 imm :: Imm
imm) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "xoris",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Imm -> SDoc
pprImm Imm
imm
    ]

pprInstr (EXTS fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "exts",
        Format -> SDoc
pprFormat Format
fmt,
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2
    ]
pprInstr (CNTLZ fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "cntlz",
        case Format
fmt of
          II32 -> Char -> SDoc
char 'w'
          II64 -> Char -> SDoc
char 'd'
          _    -> String -> SDoc
forall a. String -> a
panic "PPC: illegal format",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2
    ]

pprInstr (NEG reg1 :: Reg
reg1 reg2 :: Reg
reg2) = PtrString -> Reg -> Reg -> SDoc
pprUnary (String -> PtrString
sLit "neg") Reg
reg1 Reg
reg2
pprInstr (NOT reg1 :: Reg
reg1 reg2 :: Reg
reg2) = PtrString -> Reg -> Reg -> SDoc
pprUnary (String -> PtrString
sLit "not") Reg
reg1 Reg
reg2

pprInstr (SR II32 reg1 :: Reg
reg1 reg2 :: Reg
reg2 (RIImm (ImmInt i :: Int
i))) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0  Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 31 =
    -- Handle the case where we are asked to shift a 32 bit register by
    -- less than zero or more than 31 bits. We convert this into a clear
    -- of the destination register.
    -- Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/5900
    Instr -> SDoc
pprInstr (Reg -> Reg -> RI -> Instr
XOR Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg2))

pprInstr (SL II32 reg1 :: Reg
reg1 reg2 :: Reg
reg2 (RIImm (ImmInt i :: Int
i))) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0  Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 31 =
    -- As above for SR, but for left shifts.
    -- Fixes ticket http://ghc.haskell.org/trac/ghc/ticket/10870
    Instr -> SDoc
pprInstr (Reg -> Reg -> RI -> Instr
XOR Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg2))

pprInstr (SRA II32 reg1 :: Reg
reg1 reg2 :: Reg
reg2 (RIImm (ImmInt i :: Int
i))) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 31 =
    -- PT: I don't know what to do for negative shift amounts:
    -- For now just panic.
    --
    -- For shift amounts greater than 31 set all bit to the
    -- value of the sign bit, this also what sraw does.
    Instr -> SDoc
pprInstr (Format -> Reg -> Reg -> RI -> Instr
SRA Format
II32 Reg
reg1 Reg
reg2 (Imm -> RI
RIImm (Int -> Imm
ImmInt 31)))

pprInstr (SL fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri) =
         let op :: String
op = case Format
fmt of
                       II32 -> "slw"
                       II64 -> "sld"
                       _    -> String -> String
forall a. String -> a
panic "PPC.Ppr.pprInstr: shift illegal size"
         in PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit String
op) Reg
reg1 Reg
reg2 (Format -> RI -> RI
limitShiftRI Format
fmt RI
ri)

pprInstr (SR fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri) =
         let op :: String
op = case Format
fmt of
                       II32 -> "srw"
                       II64 -> "srd"
                       _    -> String -> String
forall a. String -> a
panic "PPC.Ppr.pprInstr: shift illegal size"
         in PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit String
op) Reg
reg1 Reg
reg2 (Format -> RI -> RI
limitShiftRI Format
fmt RI
ri)

pprInstr (SRA fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri) =
         let op :: String
op = case Format
fmt of
                       II32 -> "sraw"
                       II64 -> "srad"
                       _    -> String -> String
forall a. String -> a
panic "PPC.Ppr.pprInstr: shift illegal size"
         in PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic (String -> PtrString
sLit String
op) Reg
reg1 Reg
reg2 (Format -> RI -> RI
limitShiftRI Format
fmt RI
ri)

pprInstr (RLWINM reg1 :: Reg
reg1 reg2 :: Reg
reg2 sh :: Int
sh mb :: Int
mb me :: Int
me) = [SDoc] -> SDoc
hcat [
        String -> SDoc
text "\trlwinm\t",
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Int -> SDoc
int Int
sh,
        String -> SDoc
text ", ",
        Int -> SDoc
int Int
mb,
        String -> SDoc
text ", ",
        Int -> SDoc
int Int
me
    ]

pprInstr (CLRLI fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 n :: Int
n) = [SDoc] -> SDoc
hcat [
        String -> SDoc
text "\tclrl",
        Format -> SDoc
pprFormat Format
fmt,
        String -> SDoc
text "i ",
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Int -> SDoc
int Int
n
    ]
pprInstr (CLRRI fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 n :: Int
n) = [SDoc] -> SDoc
hcat [
        String -> SDoc
text "\tclrr",
        Format -> SDoc
pprFormat Format
fmt,
        String -> SDoc
text "i ",
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Int -> SDoc
int Int
n
    ]

pprInstr (FADD fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF (String -> PtrString
sLit "fadd") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
pprInstr (FSUB fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF (String -> PtrString
sLit "fsub") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
pprInstr (FMUL fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF (String -> PtrString
sLit "fmul") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
pprInstr (FDIV fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF (String -> PtrString
sLit "fdiv") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
pprInstr (FABS reg1 :: Reg
reg1 reg2 :: Reg
reg2) = PtrString -> Reg -> Reg -> SDoc
pprUnary (String -> PtrString
sLit "fabs") Reg
reg1 Reg
reg2
pprInstr (FNEG reg1 :: Reg
reg1 reg2 :: Reg
reg2) = PtrString -> Reg -> Reg -> SDoc
pprUnary (String -> PtrString
sLit "fneg") Reg
reg1 Reg
reg2

pprInstr (FCMP reg1 :: Reg
reg1 reg2 :: Reg
reg2) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "fcmpu\t0, ",
            -- 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.
            -- Morever, we use `fcmpu 0, ...` rather than `fcmpu cr0, ...` for
            -- better portability since some non-GNU assembler (such as
            -- IBM's `as`) tend not to support the symbolic register name cr0.
            -- This matches the syntax that GCC seems to emit for PPC targets.
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2
    ]

pprInstr (FCTIWZ reg1 :: Reg
reg1 reg2 :: Reg
reg2) = PtrString -> Reg -> Reg -> SDoc
pprUnary (String -> PtrString
sLit "fctiwz") Reg
reg1 Reg
reg2
pprInstr (FCTIDZ reg1 :: Reg
reg1 reg2 :: Reg
reg2) = PtrString -> Reg -> Reg -> SDoc
pprUnary (String -> PtrString
sLit "fctidz") Reg
reg1 Reg
reg2
pprInstr (FCFID reg1 :: Reg
reg1 reg2 :: Reg
reg2) = PtrString -> Reg -> Reg -> SDoc
pprUnary (String -> PtrString
sLit "fcfid") Reg
reg1 Reg
reg2
pprInstr (FRSP reg1 :: Reg
reg1 reg2 :: Reg
reg2) = PtrString -> Reg -> Reg -> SDoc
pprUnary (String -> PtrString
sLit "frsp") Reg
reg1 Reg
reg2

pprInstr (CRNOR dst :: Int
dst src1 :: Int
src1 src2 :: Int
src2) = [SDoc] -> SDoc
hcat [
        String -> SDoc
text "\tcrnor\t",
        Int -> SDoc
int Int
dst,
        String -> SDoc
text ", ",
        Int -> SDoc
int Int
src1,
        String -> SDoc
text ", ",
        Int -> SDoc
int Int
src2
    ]

pprInstr (MFCR reg :: Reg
reg) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "mfcr",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg
    ]

pprInstr (MFLR reg :: Reg
reg) = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "mflr",
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg
    ]

pprInstr (FETCHPC reg :: Reg
reg) = [SDoc] -> SDoc
vcat [
        String -> SDoc
text "\tbcl\t20,31,1f",
        [SDoc] -> SDoc
hcat [ String -> SDoc
text "1:\tmflr\t", Reg -> SDoc
pprReg Reg
reg ]
    ]

pprInstr HWSYNC = String -> SDoc
text "\tsync"

pprInstr ISYNC  = String -> SDoc
text "\tisync"

pprInstr LWSYNC = String -> SDoc
text "\tlwsync"

pprInstr NOP = String -> SDoc
text "\tnop"


pprLogic :: PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic :: PtrString -> Reg -> Reg -> RI -> SDoc
pprLogic op :: PtrString
op reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        PtrString -> SDoc
ptext PtrString
op,
        case RI
ri of
            RIReg _ -> SDoc
empty
            RIImm _ -> Char -> SDoc
char 'i',
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        RI -> SDoc
pprRI RI
ri
    ]


pprMul :: Format -> Reg -> Reg -> RI -> SDoc
pprMul :: Format -> Reg -> Reg -> RI -> SDoc
pprMul fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 ri :: RI
ri = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "mull",
        case RI
ri of
            RIReg _ -> case Format
fmt of
              II32 -> Char -> SDoc
char 'w'
              II64 -> Char -> SDoc
char 'd'
              _    -> String -> SDoc
forall a. String -> a
panic "PPC: illegal format"
            RIImm _ -> Char -> SDoc
char 'i',
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        RI -> SDoc
pprRI RI
ri
    ]


pprDiv :: Format -> Bool -> Reg -> Reg -> Reg -> SDoc
pprDiv :: Format -> Bool -> Reg -> Reg -> Reg -> SDoc
pprDiv fmt :: Format
fmt sgn :: Bool
sgn reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3 = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        String -> SDoc
text "div",
        case Format
fmt of
          II32 -> Char -> SDoc
char 'w'
          II64 -> Char -> SDoc
char 'd'
          _    -> String -> SDoc
forall a. String -> a
panic "PPC: illegal format",
        if Bool
sgn then SDoc
empty else Char -> SDoc
char 'u',
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg3
    ]


pprUnary :: PtrString -> Reg -> Reg -> SDoc
pprUnary :: PtrString -> Reg -> Reg -> SDoc
pprUnary op :: PtrString
op reg1 :: Reg
reg1 reg2 :: Reg
reg2 = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        PtrString -> SDoc
ptext PtrString
op,
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2
    ]


pprBinaryF :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF op :: PtrString
op fmt :: Format
fmt reg1 :: Reg
reg1 reg2 :: Reg
reg2 reg3 :: Reg
reg3 = [SDoc] -> SDoc
hcat [
        Char -> SDoc
char '\t',
        PtrString -> SDoc
ptext PtrString
op,
        Format -> SDoc
pprFFormat Format
fmt,
        Char -> SDoc
char '\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg2,
        String -> SDoc
text ", ",
        Reg -> SDoc
pprReg Reg
reg3
    ]

pprRI :: RI -> SDoc
pprRI :: RI -> SDoc
pprRI (RIReg r :: Reg
r) = Reg -> SDoc
pprReg Reg
r
pprRI (RIImm r :: Imm
r) = Imm -> SDoc
pprImm Imm
r


pprFFormat :: Format -> SDoc
pprFFormat :: Format -> SDoc
pprFFormat FF64     = SDoc
empty
pprFFormat FF32     = Char -> SDoc
char 's'
pprFFormat _        = String -> SDoc
forall a. String -> a
panic "PPC.Ppr.pprFFormat: no match"

    -- limit immediate argument for shift instruction to range 0..63
    -- for 64 bit size and 0..32 otherwise
limitShiftRI :: Format -> RI -> RI
limitShiftRI :: Format -> RI -> RI
limitShiftRI II64 (RIImm (ImmInt i :: Int
i)) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 63 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 =
  String -> RI
forall a. String -> a
panic (String -> RI) -> String -> RI
forall a b. (a -> b) -> a -> b
$ "PPC.Ppr: Shift by " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ " bits is not allowed."
limitShiftRI II32 (RIImm (ImmInt i :: Int
i)) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 31 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< 0 =
  String -> RI
forall a. String -> a
panic (String -> RI) -> String -> RI
forall a b. (a -> b) -> a -> b
$ "PPC.Ppr: 32 bit: Shift by " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ " bits is not allowed."
limitShiftRI _ x :: RI
x = RI
x