{-# LANGUAGE LambdaCase #-}

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

module GHC.CmmToAsm.PPC.Ppr
   ( pprNatCmmDecl
   , pprInstr
   )
where

import GHC.Prelude

import GHC.CmmToAsm.PPC.Regs
import GHC.CmmToAsm.PPC.Instr
import GHC.CmmToAsm.PPC.Cond
import GHC.CmmToAsm.Ppr
import GHC.CmmToAsm.Format
import GHC.Platform.Reg
import GHC.Platform.Reg.Class
import GHC.CmmToAsm.Reg.Target
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils

import GHC.Cmm hiding (topInfoTable)
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm.Dataflow.Label

import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.Ppr.Expr () -- For Outputable instances

import GHC.Types.Unique ( pprUniqueAlways, getUnique )
import GHC.Platform
import GHC.Utils.Outputable
import GHC.Utils.Panic

import Data.Word
import Data.Int

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

pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc
pprNatCmmDecl NCGConfig
config (CmmData Section
section RawCmmStatics
dats) =
  NCGConfig -> Section -> SDoc
pprSectionAlign NCGConfig
config Section
section
  SDoc -> SDoc -> SDoc
$$ Platform -> RawCmmStatics -> SDoc
pprDatas (NCGConfig -> Platform
ncgPlatform NCGConfig
config) RawCmmStatics
dats

pprNatCmmDecl NCGConfig
config proc :: NatCmmDecl RawCmmStatics Instr
proc@(CmmProc LabelMap RawCmmStatics
top_info CLabel
lbl [GlobalReg]
_ (ListGraph [GenBasicBlock Instr]
blocks)) =
  let platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config in
  case NatCmmDecl RawCmmStatics Instr -> Maybe RawCmmStatics
forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable NatCmmDecl RawCmmStatics Instr
proc of
    Maybe RawCmmStatics
Nothing ->
         -- special case for code without info table:
         NCGConfig -> Section -> SDoc
pprSectionAlign NCGConfig
config (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
lbl) SDoc -> SDoc -> SDoc
$$
         (case Platform -> Arch
platformArch Platform
platform of
            ArchPPC_64 PPC_64ABI
ELF_V1 -> Platform -> CLabel -> SDoc
pprFunctionDescriptor Platform
platform CLabel
lbl
            ArchPPC_64 PPC_64ABI
ELF_V2 -> Platform -> CLabel -> SDoc
pprFunctionPrologue Platform
platform CLabel
lbl
            Arch
_ -> Platform -> CLabel -> SDoc
pprLabel Platform
platform 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 (NCGConfig -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock NCGConfig
config LabelMap RawCmmStatics
top_info) [GenBasicBlock Instr]
blocks) SDoc -> SDoc -> SDoc
$$
         Bool -> SDoc -> SDoc
ppWhen (NCGConfig -> Bool
ncgDwarfEnabled NCGConfig
config) (Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (CLabel -> CLabel
mkAsmTempEndLabel CLabel
lbl)
                                          SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' SDoc -> SDoc -> SDoc
$$
                                          Platform -> CLabel -> SDoc
pprProcEndLabel Platform
platform CLabel
lbl) SDoc -> SDoc -> SDoc
$$
         Platform -> CLabel -> SDoc
pprSizeDecl Platform
platform CLabel
lbl

    Just (CmmStaticsRaw CLabel
info_lbl [CmmStatic]
_) ->
      NCGConfig -> Section -> SDoc
pprSectionAlign NCGConfig
config (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
info_lbl) SDoc -> SDoc -> SDoc
$$
      (if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
          then Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':'
          else SDoc
empty) SDoc -> SDoc -> SDoc
$$
      [SDoc] -> SDoc
vcat ((GenBasicBlock Instr -> SDoc) -> [GenBasicBlock Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (NCGConfig -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock NCGConfig
config LabelMap RawCmmStatics
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 String
"\t.long "
            SDoc -> SDoc -> SDoc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
info_lbl
            SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'-'
            SDoc -> SDoc -> SDoc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl)
       else SDoc
empty) SDoc -> SDoc -> SDoc
$$
      Platform -> CLabel -> SDoc
pprSizeDecl Platform
platform CLabel
info_lbl

-- | Output the ELF .size directive.
pprSizeDecl :: Platform -> CLabel -> SDoc
pprSizeDecl :: Platform -> CLabel -> SDoc
pprSizeDecl Platform
platform CLabel
lbl
 = if OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform)
   then String -> SDoc
text String
"\t.size" SDoc -> SDoc -> SDoc
<+> SDoc
prettyLbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
", .-" SDoc -> SDoc -> SDoc
<> SDoc
codeLbl
   else SDoc
empty
  where
    prettyLbl :: SDoc
prettyLbl = Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl
    codeLbl :: SDoc
codeLbl
      | Platform -> Arch
platformArch Platform
platform Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 = Char -> SDoc
char Char
'.' SDoc -> SDoc -> SDoc
<> SDoc
prettyLbl
      | Bool
otherwise                                  = SDoc
prettyLbl

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

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

pprProcEndLabel :: Platform -> CLabel -- ^ Procedure name
                -> SDoc
pprProcEndLabel :: Platform -> CLabel -> SDoc
pprProcEndLabel Platform
platform CLabel
lbl =
    Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (CLabel -> CLabel
mkAsmTempProcEndLabel CLabel
lbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':'

pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
              -> SDoc
pprBasicBlock :: NCGConfig -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock NCGConfig
config LabelMap RawCmmStatics
info_env (BasicBlock BlockId
blockid [Instr]
instrs)
  = SDoc
maybe_infotable SDoc -> SDoc -> SDoc
$$
    Platform -> CLabel -> SDoc
pprLabel Platform
platform CLabel
asmLbl SDoc -> SDoc -> SDoc
$$
    [SDoc] -> SDoc
vcat ((Instr -> SDoc) -> [Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Instr -> SDoc
pprInstr Platform
platform) [Instr]
instrs) SDoc -> SDoc -> SDoc
$$
    Bool -> SDoc -> SDoc
ppWhen (NCGConfig -> Bool
ncgDwarfEnabled NCGConfig
config) (
      Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (CLabel -> CLabel
mkAsmTempEndLabel CLabel
asmLbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':'
      SDoc -> SDoc -> SDoc
<> Platform -> CLabel -> SDoc
pprProcEndLabel Platform
platform CLabel
asmLbl
    )
  where
    asmLbl :: CLabel
asmLbl = BlockId -> CLabel
blockLbl BlockId
blockid
    platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
    maybe_infotable :: SDoc
maybe_infotable = case KeyOf LabelMap -> LabelMap RawCmmStatics -> Maybe RawCmmStatics
forall a. KeyOf LabelMap -> LabelMap a -> Maybe a
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
blockid LabelMap RawCmmStatics
info_env of
       Maybe RawCmmStatics
Nothing   -> SDoc
empty
       Just (CmmStaticsRaw CLabel
info_lbl [CmmStatic]
info) ->
           Platform -> SectionType -> SDoc
pprAlignForSection Platform
platform SectionType
Text SDoc -> SDoc -> SDoc
$$
           [SDoc] -> SDoc
vcat ((CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmStatic -> SDoc
pprData Platform
platform) [CmmStatic]
info) SDoc -> SDoc -> SDoc
$$
           Platform -> CLabel -> SDoc
pprLabel Platform
platform CLabel
info_lbl



pprDatas :: Platform -> RawCmmStatics -> SDoc
-- See Note [emit-time elimination of static indirections] in "GHC.Cmm.CLabel".
pprDatas :: Platform -> RawCmmStatics -> SDoc
pprDatas Platform
platform (CmmStaticsRaw CLabel
alias [CmmStaticLit (CmmLabel CLabel
lbl), CmmStaticLit CmmLit
ind, CmmStatic
_, CmmStatic
_])
  | CLabel
lbl CLabel -> CLabel -> Bool
forall a. Eq a => a -> a -> Bool
== CLabel
mkIndStaticInfoLabel
  , let labelInd :: CmmLit -> Maybe CLabel
labelInd (CmmLabelOff CLabel
l Int
_) = CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
l
        labelInd (CmmLabel CLabel
l) = CLabel -> Maybe CLabel
forall a. a -> Maybe a
Just CLabel
l
        labelInd CmmLit
_ = Maybe CLabel
forall a. Maybe a
Nothing
  , Just CLabel
ind' <- CmmLit -> Maybe CLabel
labelInd CmmLit
ind
  , CLabel
alias CLabel -> CLabel -> Bool
`mayRedirectTo` CLabel
ind'
  = Platform -> CLabel -> SDoc
pprGloblDecl Platform
platform CLabel
alias
    SDoc -> SDoc -> SDoc
$$ String -> SDoc
text String
".equiv" SDoc -> SDoc -> SDoc
<+> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
alias SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> Platform -> CmmLit -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform (CLabel -> CmmLit
CmmLabel CLabel
ind')
pprDatas Platform
platform (CmmStaticsRaw CLabel
lbl [CmmStatic]
dats) = [SDoc] -> SDoc
vcat (Platform -> CLabel -> SDoc
pprLabel Platform
platform CLabel
lbl SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmStatic -> SDoc
pprData Platform
platform) [CmmStatic]
dats)

pprData :: Platform -> CmmStatic -> SDoc
pprData :: Platform -> CmmStatic -> SDoc
pprData Platform
platform CmmStatic
d = case CmmStatic
d of
   CmmString ByteString
str          -> ByteString -> SDoc
pprString ByteString
str
   CmmFileEmbed String
path      -> String -> SDoc
pprFileEmbed String
path
   CmmUninitialised Int
bytes -> String -> SDoc
text String
".space " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
bytes
   CmmStaticLit CmmLit
lit       -> Platform -> CmmLit -> SDoc
pprDataItem Platform
platform CmmLit
lit

pprGloblDecl :: Platform -> CLabel -> SDoc
pprGloblDecl :: Platform -> CLabel -> SDoc
pprGloblDecl Platform
platform CLabel
lbl
  | Bool -> Bool
not (CLabel -> Bool
externallyVisibleCLabel CLabel
lbl) = SDoc
empty
  | Bool
otherwise = String -> SDoc
text String
".globl " SDoc -> SDoc -> SDoc
<> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl

pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
pprTypeAndSizeDecl :: Platform -> CLabel -> SDoc
pprTypeAndSizeDecl Platform
platform CLabel
lbl
  = 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 String
".type " SDoc -> SDoc -> SDoc
<>
         Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
", @object"
    else SDoc
empty

pprLabel :: Platform -> CLabel -> SDoc
pprLabel :: Platform -> CLabel -> SDoc
pprLabel Platform
platform CLabel
lbl =
   Platform -> CLabel -> SDoc
pprGloblDecl Platform
platform CLabel
lbl
   SDoc -> SDoc -> SDoc
$$ Platform -> CLabel -> SDoc
pprTypeAndSizeDecl Platform
platform CLabel
lbl
   SDoc -> SDoc -> SDoc
$$ (Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':')

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

pprReg :: Reg -> SDoc

pprReg :: Reg -> SDoc
pprReg Reg
r
  = case Reg
r of
      RegReal    (RealRegSingle Int
i) -> Int -> SDoc
ppr_reg_no Int
i
      RegVirtual (VirtualRegI  Unique
u)  -> String -> SDoc
text String
"%vI_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegHi Unique
u)  -> String -> SDoc
text String
"%vHi_"  SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegF  Unique
u)  -> String -> SDoc
text String
"%vF_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
      RegVirtual (VirtualRegD  Unique
u)  -> String -> SDoc
text String
"%vD_"   SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u

  where
    ppr_reg_no :: Int -> SDoc
    ppr_reg_no :: Int -> SDoc
ppr_reg_no Int
i
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
31   = Int -> SDoc
int Int
i      -- GPRs
         | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
63   = Int -> SDoc
int (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
32) -- FPRs
         | Bool
otherwise = String -> SDoc
text String
"very naughty powerpc register"



pprFormat :: Format -> SDoc
pprFormat :: Format -> SDoc
pprFormat Format
x
 = case Format
x of
                Format
II8  -> String -> SDoc
text String
"b"
                Format
II16 -> String -> SDoc
text String
"h"
                Format
II32 -> String -> SDoc
text String
"w"
                Format
II64 -> String -> SDoc
text String
"d"
                Format
FF32 -> String -> SDoc
text String
"fs"
                Format
FF64 -> String -> SDoc
text String
"fd"


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


pprImm :: Platform -> Imm -> SDoc
pprImm :: Platform -> Imm -> SDoc
pprImm Platform
platform = \case
   ImmInt Int
i       -> Int -> SDoc
int Int
i
   ImmInteger Integer
i   -> Integer -> SDoc
integer Integer
i
   ImmCLbl CLabel
l      -> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
l
   ImmIndex CLabel
l Int
i   -> Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
l SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i
   ImmLit SDoc
s       -> SDoc
s
   ImmFloat Rational
f     -> Float -> SDoc
float (Float -> SDoc) -> Float -> SDoc
forall a b. (a -> b) -> a -> b
$ Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
f
   ImmDouble Rational
d    -> Double -> SDoc
double (Double -> SDoc) -> Double -> SDoc
forall a b. (a -> b) -> a -> b
$ Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
d
   ImmConstantSum Imm
a Imm
b   -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
a SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
b
   ImmConstantDiff Imm
a Imm
b  -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
a SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-' SDoc -> SDoc -> SDoc
<> SDoc
lparen SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
b SDoc -> SDoc -> SDoc
<> SDoc
rparen
   LO (ImmInt Int
i)        -> Platform -> Imm -> SDoc
pprImm Platform
platform (Imm -> Imm
LO (Integer -> Imm
ImmInteger (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i)))
   LO (ImmInteger Integer
i)    -> Platform -> Imm -> SDoc
pprImm Platform
platform (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
.&. Integer
0xffff) :: Int16

   LO Imm
i              -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@l"
   HI Imm
i              -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@h"
   HA (ImmInt Int
i)     -> Platform -> Imm -> SDoc
pprImm Platform
platform (Imm -> Imm
HA (Integer -> Imm
ImmInteger (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i)))
   HA (ImmInteger Integer
i) -> Platform -> Imm -> SDoc
pprImm Platform
platform (Integer -> Imm
ImmInteger Integer
ha16)
        where
          ha16 :: Integer
ha16 = if Integer
lo16 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0x8000 then Integer
hi16Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1 else Integer
hi16
          hi16 :: Integer
hi16 = (Integer
i Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
16)
          lo16 :: Integer
lo16 = Integer
i Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
0xffff

   HA Imm
i        -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@ha"
   HIGHERA Imm
i   -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@highera"
   HIGHESTA Imm
i  -> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
i SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"@highesta"


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


pprSectionAlign :: NCGConfig -> Section -> SDoc
pprSectionAlign :: NCGConfig -> Section -> SDoc
pprSectionAlign NCGConfig
config sec :: Section
sec@(Section SectionType
seg CLabel
_) =
   NCGConfig -> Section -> SDoc
pprSectionHeader NCGConfig
config Section
sec SDoc -> SDoc -> SDoc
$$
   Platform -> SectionType -> SDoc
pprAlignForSection (NCGConfig -> Platform
ncgPlatform NCGConfig
config) SectionType
seg

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

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

        ppr_item :: Format -> CmmLit -> [SDoc]
ppr_item Format
II8  CmmLit
_ = [String -> SDoc
text String
"\t.byte\t"  SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]
        ppr_item Format
II16 CmmLit
_ = [String -> SDoc
text String
"\t.short\t" SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]
        ppr_item Format
II32 CmmLit
_ = [String -> SDoc
text String
"\t.long\t"  SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]
        ppr_item Format
II64 CmmLit
_
           | Bool
archPPC_64 = [String -> SDoc
text String
"\t.quad\t"  SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]

        ppr_item Format
II64 (CmmInt Integer
x Width
_)
           | Bool -> Bool
not Bool
archPPC_64 =
                [String -> SDoc
text String
"\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` Int
32) :: Word32)),
                 String -> SDoc
text String
"\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 Format
FF32 CmmLit
_ = [String -> SDoc
text String
"\t.float\t" SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]
        ppr_item Format
FF64 CmmLit
_ = [String -> SDoc
text String
"\t.double\t" SDoc -> SDoc -> SDoc
<> Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm]

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


asmComment :: SDoc -> SDoc
asmComment :: SDoc -> SDoc
asmComment SDoc
c = SDoc -> SDoc
whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"#" SDoc -> SDoc -> SDoc
<+> SDoc
c


pprInstr :: Platform -> Instr -> SDoc
pprInstr :: Platform -> Instr -> SDoc
pprInstr Platform
platform Instr
instr = case Instr
instr of

   COMMENT SDoc
s
      -> SDoc -> SDoc
asmComment SDoc
s

   LOCATION Int
file Int
line Int
col String
_name
      -> String -> SDoc
text String
"\t.loc" SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
file SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
line SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
col

   DELTA Int
d
      -> SDoc -> SDoc
asmComment (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text (String
"\tdelta = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d)

   NEWBLOCK BlockId
_
      -> String -> SDoc
forall a. String -> a
panic String
"PprMach.pprInstr: NEWBLOCK"

   LDATA Section
_ RawCmmStatics
_
      -> String -> SDoc
forall a. String -> a
panic String
"PprMach.pprInstr: LDATA"

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

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

   LD Format
fmt Reg
reg AddrMode
addr
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"l",
           (case Format
fmt of
               Format
II8  -> String -> SDoc
text String
"bz"
               Format
II16 -> String -> SDoc
text String
"hz"
               Format
II32 -> String -> SDoc
text String
"wz"
               Format
II64 -> String -> SDoc
text String
"d"
               Format
FF32 -> String -> SDoc
text String
"fs"
               Format
FF64 -> String -> SDoc
text String
"fd"
               ),
           case AddrMode
addr of AddrRegImm Reg
_ Imm
_ -> SDoc
empty
                        AddrRegReg Reg
_ Reg
_ -> Char -> SDoc
char Char
'x',
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg,
           String -> SDoc
text String
", ",
           Platform -> AddrMode -> SDoc
pprAddr Platform
platform AddrMode
addr
       ]

   LDFAR Format
fmt Reg
reg (AddrRegImm Reg
source Imm
off)
      -> [SDoc] -> SDoc
vcat
            [ Platform -> Instr -> SDoc
pprInstr Platform
platform (Reg -> Reg -> Imm -> Instr
ADDIS (Platform -> Reg
tmpReg Platform
platform) Reg
source (Imm -> Imm
HA Imm
off))
            , Platform -> Instr -> SDoc
pprInstr Platform
platform (Format -> Reg -> AddrMode -> Instr
LD Format
fmt Reg
reg (Reg -> Imm -> AddrMode
AddrRegImm (Platform -> Reg
tmpReg Platform
platform) (Imm -> Imm
LO Imm
off)))
            ]

   LDFAR Format
_ Reg
_ AddrMode
_
      -> String -> SDoc
forall a. String -> a
panic String
"PPC.Ppr.pprInstr LDFAR: no match"

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

   LA Format
fmt Reg
reg AddrMode
addr
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"l",
           (case Format
fmt of
               Format
II8  -> String -> SDoc
text String
"ba"
               Format
II16 -> String -> SDoc
text String
"ha"
               Format
II32 -> String -> SDoc
text String
"wa"
               Format
II64 -> String -> SDoc
text String
"d"
               Format
FF32 -> String -> SDoc
text String
"fs"
               Format
FF64 -> String -> SDoc
text String
"fd"
               ),
           case AddrMode
addr of AddrRegImm Reg
_ Imm
_ -> SDoc
empty
                        AddrRegReg Reg
_ Reg
_ -> Char -> SDoc
char Char
'x',
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg,
           String -> SDoc
text String
", ",
           Platform -> AddrMode -> SDoc
pprAddr Platform
platform AddrMode
addr
           ]

   ST Format
fmt Reg
reg AddrMode
addr
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"st",
           Format -> SDoc
pprFormat Format
fmt,
           case AddrMode
addr of AddrRegImm Reg
_ Imm
_ -> SDoc
empty
                        AddrRegReg Reg
_ Reg
_ -> Char -> SDoc
char Char
'x',
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg,
           String -> SDoc
text String
", ",
           Platform -> AddrMode -> SDoc
pprAddr Platform
platform AddrMode
addr
           ]

   STFAR Format
fmt Reg
reg (AddrRegImm Reg
source Imm
off)
      -> [SDoc] -> SDoc
vcat [ Platform -> Instr -> SDoc
pprInstr Platform
platform (Reg -> Reg -> Imm -> Instr
ADDIS (Platform -> Reg
tmpReg Platform
platform) Reg
source (Imm -> Imm
HA Imm
off))
              , Platform -> Instr -> SDoc
pprInstr Platform
platform (Format -> Reg -> AddrMode -> Instr
ST Format
fmt Reg
reg (Reg -> Imm -> AddrMode
AddrRegImm (Platform -> Reg
tmpReg Platform
platform) (Imm -> Imm
LO Imm
off)))
              ]

   STFAR Format
_ Reg
_ AddrMode
_
      -> String -> SDoc
forall a. String -> a
panic String
"PPC.Ppr.pprInstr STFAR: no match"

   STU Format
fmt Reg
reg AddrMode
addr
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"st",
           Format -> SDoc
pprFormat Format
fmt,
           Char -> SDoc
char Char
'u',
           case AddrMode
addr of AddrRegImm Reg
_ Imm
_ -> SDoc
empty
                        AddrRegReg Reg
_ Reg
_ -> Char -> SDoc
char Char
'x',
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg,
           String -> SDoc
text String
", ",
           Platform -> AddrMode -> SDoc
pprAddr Platform
platform AddrMode
addr
           ]

   STC Format
fmt Reg
reg1 AddrMode
addr
      -> [SDoc] -> SDoc
hcat [
           String -> SDoc
text String
"\tst",
           case Format
fmt of
             Format
II32 -> Char -> SDoc
char Char
'w'
             Format
II64 -> Char -> SDoc
char Char
'd'
             Format
_    -> String -> SDoc
forall a. String -> a
panic String
"PPC.Ppr.Instr STC: no match",
           String -> SDoc
text String
"cx.\t",
           Reg -> SDoc
pprReg Reg
reg1,
           String -> SDoc
text String
", ",
           Platform -> AddrMode -> SDoc
pprAddr Platform
platform AddrMode
addr
           ]

   LIS Reg
reg Imm
imm
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"lis",
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg,
           String -> SDoc
text String
", ",
           Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm
           ]

   LI Reg
reg Imm
imm
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"li",
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg,
           String -> SDoc
text String
", ",
           Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm
           ]

   MR Reg
reg1 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 Char
'\t',
        case Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
reg1 of
            RegClass
RcInteger -> String -> SDoc
text String
"mr"
            RegClass
_ -> String -> SDoc
text String
"fmr",
        Char -> SDoc
char Char
'\t',
        Reg -> SDoc
pprReg Reg
reg1,
        String -> SDoc
text String
", ",
        Reg -> SDoc
pprReg Reg
reg2
        ]

   CMP Format
fmt Reg
reg RI
ri
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           SDoc
op,
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg,
           String -> SDoc
text String
", ",
           Platform -> RI -> SDoc
pprRI Platform
platform RI
ri
           ]
         where
           op :: SDoc
op = [SDoc] -> SDoc
hcat [
                   String -> SDoc
text String
"cmp",
                   Format -> SDoc
pprFormat Format
fmt,
                   case RI
ri of
                       RIReg Reg
_ -> SDoc
empty
                       RIImm Imm
_ -> Char -> SDoc
char Char
'i'
               ]

   CMPL Format
fmt Reg
reg RI
ri
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           SDoc
op,
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg,
           String -> SDoc
text String
", ",
           Platform -> RI -> SDoc
pprRI Platform
platform RI
ri
           ]
          where
              op :: SDoc
op = [SDoc] -> SDoc
hcat [
                      String -> SDoc
text String
"cmpl",
                      Format -> SDoc
pprFormat Format
fmt,
                      case RI
ri of
                          RIReg Reg
_ -> SDoc
empty
                          RIImm Imm
_ -> Char -> SDoc
char Char
'i'
                  ]

   BCC Cond
cond BlockId
blockid Maybe Bool
prediction
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"b",
           Cond -> SDoc
pprCond Cond
cond,
           Maybe Bool -> SDoc
pprPrediction Maybe Bool
prediction,
           Char -> SDoc
char Char
'\t',
           Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform 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 Maybe Bool
p = case Maybe Bool
p of
                 Maybe Bool
Nothing    -> SDoc
empty
                 Just Bool
True  -> Char -> SDoc
char Char
'+'
                 Just Bool
False -> Char -> SDoc
char Char
'-'

   BCCFAR Cond
cond BlockId
blockid Maybe Bool
prediction
      -> [SDoc] -> SDoc
vcat [
           [SDoc] -> SDoc
hcat [
               String -> SDoc
text String
"\tb",
               Cond -> SDoc
pprCond (Cond -> Cond
condNegate Cond
cond),
               SDoc
neg_prediction,
               String -> SDoc
text String
"\t$+8"
           ],
           [SDoc] -> SDoc
hcat [
               String -> SDoc
text String
"\tb\t",
               Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform 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
                  Maybe Bool
Nothing    -> SDoc
empty
                  Just Bool
True  -> Char -> SDoc
char Char
'-'
                  Just Bool
False -> Char -> SDoc
char Char
'+'

   JMP CLabel
lbl [Reg]
_
     -- 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 String
"PPC.Ppr.pprInstr: JMP to ForeignLabel"
     | Bool
otherwise ->
       [SDoc] -> SDoc
hcat [ -- an alias for b that takes a CLabel
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"b",
           Char -> SDoc
char Char
'\t',
           Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl
       ]

   MTCTR Reg
reg
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"mtctr",
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg
        ]

   BCTR [Maybe BlockId]
_ Maybe CLabel
_ [Reg]
_
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"bctr"
         ]

   BL CLabel
lbl [Reg]
_
      -> case Platform -> OS
platformOS Platform
platform of
           OS
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 String
"\tbl\t.",
               Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl
             ]
           OS
_ ->
             [SDoc] -> SDoc
hcat [
               String -> SDoc
text String
"\tbl\t",
               Platform -> CLabel -> SDoc
forall env a. OutputableP env a => env -> a -> SDoc
pdoc Platform
platform CLabel
lbl
             ]

   BCTRL [Reg]
_
      -> [SDoc] -> SDoc
hcat [
             Char -> SDoc
char Char
'\t',
             String -> SDoc
text String
"bctrl"
         ]

   ADD Reg
reg1 Reg
reg2 RI
ri
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"add") Reg
reg1 Reg
reg2 RI
ri

   ADDIS Reg
reg1 Reg
reg2 Imm
imm
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"addis",
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg1,
           String -> SDoc
text String
", ",
           Reg -> SDoc
pprReg Reg
reg2,
           String -> SDoc
text String
", ",
           Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm
           ]

   ADDO Reg
reg1 Reg
reg2 Reg
reg3
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"addo") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)

   ADDC Reg
reg1 Reg
reg2 Reg
reg3
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"addc") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)

   ADDE Reg
reg1 Reg
reg2 Reg
reg3
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"adde") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)

   ADDZE Reg
reg1 Reg
reg2
      -> SDoc -> Reg -> Reg -> SDoc
pprUnary (String -> SDoc
text String
"addze") Reg
reg1 Reg
reg2

   SUBF Reg
reg1 Reg
reg2 Reg
reg3
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"subf") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)

   SUBFO Reg
reg1 Reg
reg2 Reg
reg3
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"subfo") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)

   SUBFC Reg
reg1 Reg
reg2 RI
ri
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"subf",
           case RI
ri of
               RIReg Reg
_ -> SDoc
empty
               RIImm Imm
_ -> Char -> SDoc
char Char
'i',
           String -> SDoc
text String
"c\t",
           Reg -> SDoc
pprReg Reg
reg1,
           String -> SDoc
text String
", ",
           Reg -> SDoc
pprReg Reg
reg2,
           String -> SDoc
text String
", ",
           Platform -> RI -> SDoc
pprRI Platform
platform RI
ri
           ]

   SUBFE Reg
reg1 Reg
reg2 Reg
reg3
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"subfe") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)

   MULL Format
fmt Reg
reg1 Reg
reg2 RI
ri
      -> Platform -> Format -> Reg -> Reg -> RI -> SDoc
pprMul Platform
platform Format
fmt Reg
reg1 Reg
reg2 RI
ri

   MULLO Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
      -> [SDoc] -> SDoc
hcat [
             Char -> SDoc
char Char
'\t',
             String -> SDoc
text String
"mull",
             case Format
fmt of
               Format
II32 -> Char -> SDoc
char Char
'w'
               Format
II64 -> Char -> SDoc
char Char
'd'
               Format
_    -> String -> SDoc
forall a. String -> a
panic String
"PPC: illegal format",
             String -> SDoc
text String
"o\t",
             Reg -> SDoc
pprReg Reg
reg1,
             String -> SDoc
text String
", ",
             Reg -> SDoc
pprReg Reg
reg2,
             String -> SDoc
text String
", ",
             Reg -> SDoc
pprReg Reg
reg3
         ]

   MFOV Format
fmt Reg
reg
      -> [SDoc] -> SDoc
vcat [
           [SDoc] -> SDoc
hcat [
               Char -> SDoc
char Char
'\t',
               String -> SDoc
text String
"mfxer",
               Char -> SDoc
char Char
'\t',
               Reg -> SDoc
pprReg Reg
reg
               ],
           [SDoc] -> SDoc
hcat [
               Char -> SDoc
char Char
'\t',
               String -> SDoc
text String
"extr",
               case Format
fmt of
                 Format
II32 -> Char -> SDoc
char Char
'w'
                 Format
II64 -> Char -> SDoc
char Char
'd'
                 Format
_    -> String -> SDoc
forall a. String -> a
panic String
"PPC: illegal format",
               String -> SDoc
text String
"i\t",
               Reg -> SDoc
pprReg Reg
reg,
               String -> SDoc
text String
", ",
               Reg -> SDoc
pprReg Reg
reg,
               String -> SDoc
text String
", 1, ",
               case Format
fmt of
                 Format
II32 -> String -> SDoc
text String
"1"
                 Format
II64 -> String -> SDoc
text String
"33"
                 Format
_    -> String -> SDoc
forall a. String -> a
panic String
"PPC: illegal format"
               ]
           ]

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

   DIV Format
fmt Bool
sgn Reg
reg1 Reg
reg2 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.
   AND Reg
reg1 Reg
reg2 (RIImm Imm
imm)
      -> [SDoc] -> SDoc
hcat [
            Char -> SDoc
char Char
'\t',
            String -> SDoc
text String
"andi.",
            Char -> SDoc
char Char
'\t',
            Reg -> SDoc
pprReg Reg
reg1,
            String -> SDoc
text String
", ",
            Reg -> SDoc
pprReg Reg
reg2,
            String -> SDoc
text String
", ",
            Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm
        ]

   AND Reg
reg1 Reg
reg2 RI
ri
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"and") Reg
reg1 Reg
reg2 RI
ri

   ANDC Reg
reg1 Reg
reg2 Reg
reg3
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"andc") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)

   NAND Reg
reg1 Reg
reg2 Reg
reg3
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"nand") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)

   OR Reg
reg1 Reg
reg2 RI
ri
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"or") Reg
reg1 Reg
reg2 RI
ri

   XOR Reg
reg1 Reg
reg2 RI
ri
      -> Platform -> SDoc -> Reg -> Reg -> RI -> SDoc
pprLogic Platform
platform (String -> SDoc
text String
"xor") Reg
reg1 Reg
reg2 RI
ri

   ORIS Reg
reg1 Reg
reg2 Imm
imm
      -> [SDoc] -> SDoc
hcat [
            Char -> SDoc
char Char
'\t',
            String -> SDoc
text String
"oris",
            Char -> SDoc
char Char
'\t',
            Reg -> SDoc
pprReg Reg
reg1,
            String -> SDoc
text String
", ",
            Reg -> SDoc
pprReg Reg
reg2,
            String -> SDoc
text String
", ",
            Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm
        ]

   XORIS Reg
reg1 Reg
reg2 Imm
imm
      -> [SDoc] -> SDoc
hcat [
            Char -> SDoc
char Char
'\t',
            String -> SDoc
text String
"xoris",
            Char -> SDoc
char Char
'\t',
            Reg -> SDoc
pprReg Reg
reg1,
            String -> SDoc
text String
", ",
            Reg -> SDoc
pprReg Reg
reg2,
            String -> SDoc
text String
", ",
            Platform -> Imm -> SDoc
pprImm Platform
platform Imm
imm
        ]

   EXTS Format
fmt Reg
reg1 Reg
reg2
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"exts",
           Format -> SDoc
pprFormat Format
fmt,
           Char -> SDoc
char Char
'\t',
           Reg -> SDoc
pprReg Reg
reg1,
           String -> SDoc
text String
", ",
           Reg -> SDoc
pprReg Reg
reg2
         ]

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

   NEG Reg
reg1 Reg
reg2
      -> SDoc -> Reg -> Reg -> SDoc
pprUnary (String -> SDoc
text String
"neg") Reg
reg1 Reg
reg2

   NOT Reg
reg1 Reg
reg2
      -> SDoc -> Reg -> Reg -> SDoc
pprUnary (String -> SDoc
text String
"not") Reg
reg1 Reg
reg2

   SR Format
II32 Reg
reg1 Reg
reg2 (RIImm (ImmInt Int
i))
    -- 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 https://gitlab.haskell.org/ghc/ghc/issues/5900
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0  Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31 -> Platform -> Instr -> SDoc
pprInstr Platform
platform (Reg -> Reg -> RI -> Instr
XOR Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg2))

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

   SRA Format
II32 Reg
reg1 Reg
reg2 (RIImm (ImmInt Int
i))
    -- 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.
      | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31 -> Platform -> Instr -> SDoc
pprInstr Platform
platform (Format -> Reg -> Reg -> RI -> Instr
SRA Format
II32 Reg
reg1 Reg
reg2 (Imm -> RI
RIImm (Int -> Imm
ImmInt Int
31)))

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

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

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

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

   CLRLI Format
fmt Reg
reg1 Reg
reg2 Int
n
      -> [SDoc] -> SDoc
hcat [
            String -> SDoc
text String
"\tclrl",
            Format -> SDoc
pprFormat Format
fmt,
            String -> SDoc
text String
"i ",
            Reg -> SDoc
pprReg Reg
reg1,
            String -> SDoc
text String
", ",
            Reg -> SDoc
pprReg Reg
reg2,
            String -> SDoc
text String
", ",
            Int -> SDoc
int Int
n
        ]

   CLRRI Format
fmt Reg
reg1 Reg
reg2 Int
n
      -> [SDoc] -> SDoc
hcat [
            String -> SDoc
text String
"\tclrr",
            Format -> SDoc
pprFormat Format
fmt,
            String -> SDoc
text String
"i ",
            Reg -> SDoc
pprReg Reg
reg1,
            String -> SDoc
text String
", ",
            Reg -> SDoc
pprReg Reg
reg2,
            String -> SDoc
text String
", ",
            Int -> SDoc
int Int
n
        ]

   FADD Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
      -> SDoc -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF (String -> SDoc
text String
"fadd") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3

   FSUB Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
      -> SDoc -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF (String -> SDoc
text String
"fsub") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3

   FMUL Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
      -> SDoc -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF (String -> SDoc
text String
"fmul") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3

   FDIV Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
      -> SDoc -> Format -> Reg -> Reg -> Reg -> SDoc
pprBinaryF (String -> SDoc
text String
"fdiv") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3

   FABS Reg
reg1 Reg
reg2
      -> SDoc -> Reg -> Reg -> SDoc
pprUnary (String -> SDoc
text String
"fabs") Reg
reg1 Reg
reg2

   FNEG Reg
reg1 Reg
reg2
      -> SDoc -> Reg -> Reg -> SDoc
pprUnary (String -> SDoc
text String
"fneg") Reg
reg1 Reg
reg2

   FCMP Reg
reg1 Reg
reg2
      -> [SDoc] -> SDoc
hcat [
           Char -> SDoc
char Char
'\t',
           String -> SDoc
text String
"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.
               -- Moreover, 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 String
", ",
           Reg -> SDoc
pprReg Reg
reg2
         ]

   FCTIWZ Reg
reg1 Reg
reg2
      -> SDoc -> Reg -> Reg -> SDoc
pprUnary (String -> SDoc
text String
"fctiwz") Reg
reg1 Reg
reg2

   FCTIDZ Reg
reg1 Reg
reg2
      -> SDoc -> Reg -> Reg -> SDoc
pprUnary (String -> SDoc
text String
"fctidz") Reg
reg1 Reg
reg2

   FCFID Reg
reg1 Reg
reg2
      -> SDoc -> Reg -> Reg -> SDoc
pprUnary (String -> SDoc
text String
"fcfid") Reg
reg1 Reg
reg2

   FRSP Reg
reg1 Reg
reg2
      -> SDoc -> Reg -> Reg -> SDoc
pprUnary (String -> SDoc
text String
"frsp") Reg
reg1 Reg
reg2

   CRNOR Int
dst Int
src1 Int
src2
      -> [SDoc] -> SDoc
hcat [
           String -> SDoc
text String
"\tcrnor\t",
           Int -> SDoc
int Int
dst,
           String -> SDoc
text String
", ",
           Int -> SDoc
int Int
src1,
           String -> SDoc
text String
", ",
           Int -> SDoc
int Int
src2
         ]

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

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

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

   Instr
HWSYNC
      -> String -> SDoc
text String
"\tsync"

   Instr
ISYNC
      -> String -> SDoc
text String
"\tisync"

   Instr
LWSYNC
      -> String -> SDoc
text String
"\tlwsync"

   Instr
NOP
      -> String -> SDoc
text String
"\tnop"

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


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


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


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


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

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


pprFFormat :: Format -> SDoc
pprFFormat :: Format -> SDoc
pprFFormat Format
FF64     = SDoc
empty
pprFFormat Format
FF32     = Char -> SDoc
char Char
's'
pprFFormat Format
_        = String -> SDoc
forall a. String -> a
panic String
"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 Format
II64 (RIImm (ImmInt Int
i)) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
63 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
  String -> RI
forall a. String -> a
panic (String -> RI) -> String -> RI
forall a b. (a -> b) -> a -> b
$ String
"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]
++ String
" bits is not allowed."
limitShiftRI Format
II32 (RIImm (ImmInt Int
i)) | Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
  String -> RI
forall a. String -> a
panic (String -> RI) -> String -> RI
forall a b. (a -> b) -> a -> b
$ String
"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]
++ String
" bits is not allowed."
limitShiftRI Format
_ RI
x = RI
x