{-# LANGUAGE LambdaCase #-}
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.Unified
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.Label
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Types.Unique ( pprUniqueAlways, getUnique )
import GHC.Platform
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.Word
import Data.Int
pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
pprNatCmmDecl :: forall doc.
IsDoc doc =>
NCGConfig -> NatCmmDecl RawCmmStatics Instr -> doc
pprNatCmmDecl NCGConfig
config (CmmData Section
section RawCmmStatics
dats) =
NCGConfig -> Section -> doc
forall doc. IsDoc doc => NCGConfig -> Section -> doc
pprSectionAlign NCGConfig
config Section
section
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> RawCmmStatics -> doc
forall doc. IsDoc doc => Platform -> RawCmmStatics -> doc
pprDatas (NCGConfig -> Platform
ncgPlatform NCGConfig
config) RawCmmStatics
dats
pprNatCmmDecl NCGConfig
config proc :: NatCmmDecl RawCmmStatics Instr
proc@(CmmProc LabelMap RawCmmStatics
top_info CLabel
lbl [GlobalRegUse]
_ (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 ->
NCGConfig -> Section -> doc
forall doc. IsDoc doc => NCGConfig -> Section -> doc
pprSectionAlign NCGConfig
config (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
lbl) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
(case Platform -> Arch
platformArch Platform
platform of
ArchPPC_64 PPC_64ABI
ELF_V1 -> Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprFunctionDescriptor Platform
platform CLabel
lbl
ArchPPC_64 PPC_64ABI
ELF_V2 -> Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprFunctionPrologue Platform
platform CLabel
lbl
Arch
_ -> Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabel Platform
platform CLabel
lbl) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenBasicBlock Instr -> doc) -> [GenBasicBlock Instr] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (NCGConfig -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> doc
forall doc.
IsDoc doc =>
NCGConfig -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> doc
pprBasicBlock NCGConfig
config LabelMap RawCmmStatics
top_info) [GenBasicBlock Instr]
blocks) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Bool -> doc -> doc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (NCGConfig -> Bool
ncgDwarfEnabled NCGConfig
config) (Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempEndLabel CLabel
lbl)
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
':') doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprProcEndLabel Platform
platform CLabel
lbl)) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprSizeDecl Platform
platform CLabel
lbl
Just (CmmStaticsRaw CLabel
info_lbl [CmmStatic]
_) ->
NCGConfig -> Section -> doc
forall doc. IsDoc doc => NCGConfig -> Section -> doc
pprSectionAlign NCGConfig
config (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
info_lbl) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
(if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
then Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl) Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
':')
else doc
forall doc. IsOutput doc => doc
empty) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ((GenBasicBlock Instr -> doc) -> [GenBasicBlock Instr] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (NCGConfig -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> doc
forall doc.
IsDoc doc =>
NCGConfig -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> doc
pprBasicBlock NCGConfig
config LabelMap RawCmmStatics
top_info) [GenBasicBlock Instr]
blocks) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
(if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
then
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long "
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
info_lbl
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-'
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl))
else doc
forall doc. IsOutput doc => doc
empty) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprSizeDecl Platform
platform CLabel
info_lbl
{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> SDoc #-}
{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl RawCmmStatics Instr -> HDoc #-}
pprSizeDecl :: IsDoc doc => Platform -> CLabel -> doc
pprSizeDecl :: forall doc. IsDoc doc => Platform -> CLabel -> doc
pprSizeDecl Platform
platform CLabel
lbl
= if OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform)
then Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.size" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Line doc
prettyLbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", .-" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
codeLbl)
else doc
forall doc. IsOutput doc => doc
empty
where
prettyLbl :: Line doc
prettyLbl = Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl
codeLbl :: Line doc
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 -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'.' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
prettyLbl
| Bool
otherwise = Line doc
prettyLbl
pprFunctionDescriptor :: IsDoc doc => Platform -> CLabel -> doc
pprFunctionDescriptor :: forall doc. IsDoc doc => Platform -> CLabel -> doc
pprFunctionDescriptor Platform
platform CLabel
lab =
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprGloblDecl Platform
platform CLabel
lab,
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.section \".opd\", \"aw\""),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.align 3"),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lab Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
':'),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.quad ."
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lab
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
",.TOC.@tocbase,0"),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.previous"),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.type"
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lab
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", @function"),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'.' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lab Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
':')]
pprFunctionPrologue :: IsDoc doc => Platform -> CLabel -> doc
pprFunctionPrologue :: forall doc. IsDoc doc => Platform -> CLabel -> doc
pprFunctionPrologue Platform
platform CLabel
lab =
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprGloblDecl Platform
platform CLabel
lab,
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".type " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lab Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", @function"),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lab Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
':'),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"0:\taddis\t" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
toc Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
",12,.TOC.-0b@ha"),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\taddi\t" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
toc Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
',' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
toc Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
",.TOC.-0b@l"),
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.localentry\t" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lab Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<>
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
",.-" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lab)]
pprProcEndLabel :: IsLine doc => Platform -> CLabel
-> doc
pprProcEndLabel :: forall doc. IsLine doc => Platform -> CLabel -> doc
pprProcEndLabel Platform
platform CLabel
lbl =
Platform -> CLabel -> doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempProcEndLabel CLabel
lbl) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
':'
pprBasicBlock :: IsDoc doc => NCGConfig -> LabelMap RawCmmStatics -> NatBasicBlock Instr
-> doc
pprBasicBlock :: forall doc.
IsDoc doc =>
NCGConfig -> LabelMap RawCmmStatics -> GenBasicBlock Instr -> doc
pprBasicBlock NCGConfig
config LabelMap RawCmmStatics
info_env (BasicBlock BlockId
blockid [Instr]
instrs)
= doc
maybe_infotable doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabel Platform
platform CLabel
asmLbl doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ((Instr -> doc) -> [Instr] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform) [Instr]
instrs) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Bool -> doc -> doc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (NCGConfig -> Bool
ncgDwarfEnabled NCGConfig
config) (
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempEndLabel CLabel
asmLbl) Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
':'
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprProcEndLabel Platform
platform CLabel
asmLbl)
)
where
asmLbl :: CLabel
asmLbl = BlockId -> CLabel
blockLbl BlockId
blockid
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
maybe_infotable :: doc
maybe_infotable = case BlockId -> LabelMap RawCmmStatics -> Maybe RawCmmStatics
forall a. BlockId -> LabelMap a -> Maybe a
mapLookup BlockId
blockid LabelMap RawCmmStatics
info_env of
Maybe RawCmmStatics
Nothing -> doc
forall doc. IsOutput doc => doc
empty
Just (CmmStaticsRaw CLabel
info_lbl [CmmStatic]
info) ->
Platform -> SectionType -> doc
forall doc. IsDoc doc => Platform -> SectionType -> doc
pprAlignForSection Platform
platform SectionType
Text doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
[doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat ((CmmStatic -> doc) -> [CmmStatic] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmStatic -> doc
forall doc. IsDoc doc => Platform -> CmmStatic -> doc
pprData Platform
platform) [CmmStatic]
info) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabel Platform
platform CLabel
info_lbl
pprDatas :: IsDoc doc => Platform -> RawCmmStatics -> doc
pprDatas :: forall doc. IsDoc doc => Platform -> RawCmmStatics -> doc
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 -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprGloblDecl Platform
platform CLabel
alias
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".equiv" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
alias Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
comma Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
ind')
pprDatas Platform
platform (CmmStaticsRaw CLabel
lbl [CmmStatic]
dats) = [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat (Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabel Platform
platform CLabel
lbl doc -> [doc] -> [doc]
forall a. a -> [a] -> [a]
: (CmmStatic -> doc) -> [CmmStatic] -> [doc]
forall a b. (a -> b) -> [a] -> [b]
map (Platform -> CmmStatic -> doc
forall doc. IsDoc doc => Platform -> CmmStatic -> doc
pprData Platform
platform) [CmmStatic]
dats)
pprData :: IsDoc doc => Platform -> CmmStatic -> doc
pprData :: forall doc. IsDoc doc => Platform -> CmmStatic -> doc
pprData Platform
platform CmmStatic
d = case CmmStatic
d of
CmmString ByteString
str -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (ByteString -> Line doc
forall doc. IsLine doc => ByteString -> doc
pprString ByteString
str)
CmmFileEmbed String
path Int
_ -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
pprFileEmbed String
path)
CmmUninitialised Int
bytes -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".space " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
bytes)
CmmStaticLit CmmLit
lit -> Platform -> CmmLit -> doc
forall doc. IsDoc doc => Platform -> CmmLit -> doc
pprDataItem Platform
platform CmmLit
lit
pprGloblDecl :: IsDoc doc => Platform -> CLabel -> doc
pprGloblDecl :: forall doc. IsDoc doc => Platform -> CLabel -> doc
pprGloblDecl Platform
platform CLabel
lbl
| Bool -> Bool
not (CLabel -> Bool
externallyVisibleCLabel CLabel
lbl) = doc
forall doc. IsOutput doc => doc
empty
| Bool
otherwise = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".globl " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl)
pprTypeAndSizeDecl :: IsLine doc => Platform -> CLabel -> doc
pprTypeAndSizeDecl :: forall doc. IsLine doc => Platform -> CLabel -> doc
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 -> doc
forall doc. IsLine doc => String -> doc
text String
".type " doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<>
Platform -> CLabel -> doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
", @object"
else doc
forall doc. IsOutput doc => doc
empty
pprLabel :: IsDoc doc => Platform -> CLabel -> doc
pprLabel :: forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabel Platform
platform CLabel
lbl =
Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprGloblDecl Platform
platform CLabel
lbl
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprTypeAndSizeDecl Platform
platform CLabel
lbl)
doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
':')
pprReg :: forall doc. IsLine doc => Reg -> doc
pprReg :: forall doc. IsLine doc => Reg -> doc
pprReg Reg
r
= case Reg
r of
RegReal (RealRegSingle Int
i) -> Int -> doc
ppr_reg_no Int
i
RegVirtual (VirtualRegI Unique
u) -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%vI_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
RegVirtual (VirtualRegHi Unique
u) -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%vHi_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
RegVirtual (VirtualRegD Unique
u) -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%vD_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
RegVirtual (VirtualRegV128 Unique
u) -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%vV128_" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Unique -> doc
forall doc. IsLine doc => Unique -> doc
pprUniqueAlways Unique
u
where
ppr_reg_no :: Int -> doc
ppr_reg_no :: Int -> doc
ppr_reg_no Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
31 = Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
i
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
63 = Int -> doc
forall doc. IsLine doc => Int -> doc
int (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
32)
| Bool
otherwise = String -> doc
forall doc. IsLine doc => String -> doc
text String
"very naughty powerpc register"
pprFormat :: IsLine doc => Format -> doc
pprFormat :: forall doc. IsLine doc => Format -> doc
pprFormat Format
x
= case Format
x of
Format
II8 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"b"
Format
II16 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"h"
Format
II32 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"w"
Format
II64 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"d"
Format
FF32 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"fs"
Format
FF64 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"fd"
VecFormat {} -> String -> doc
forall a. HasCallStack => String -> a
panic String
"PPC pprFormat: VecFormat"
pprCond :: IsLine doc => Cond -> doc
pprCond :: forall doc. IsLine doc => Cond -> doc
pprCond Cond
c
= case Cond
c of {
Cond
ALWAYS -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"";
Cond
EQQ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"eq"; Cond
NE -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ne";
Cond
LTT -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"lt"; Cond
GE -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ge";
Cond
GTT -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"gt"; Cond
LE -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"le";
Cond
LU -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"lt"; Cond
GEU -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ge";
Cond
GU -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"gt"; Cond
LEU -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"le"; }
pprImm :: IsLine doc => Platform -> Imm -> doc
pprImm :: forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform = \case
ImmInt Int
i -> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
i
ImmInteger Integer
i -> Integer -> doc
forall doc. IsLine doc => Integer -> doc
integer Integer
i
ImmCLbl CLabel
l -> Platform -> CLabel -> doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
l
ImmIndex CLabel
l Int
i -> Platform -> CLabel -> doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
l doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'+' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
i
ImmLit FastString
s -> FastString -> doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
s
ImmFloat Rational
f -> Float -> doc
forall doc. IsLine doc => Float -> doc
float (Float -> doc) -> Float -> doc
forall a b. (a -> b) -> a -> b
$ Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
f
ImmDouble Rational
d -> Double -> doc
forall doc. IsLine doc => Double -> doc
double (Double -> doc) -> Double -> doc
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 -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
a doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'+' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
b
ImmConstantDiff Imm
a Imm
b -> Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
a doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'-' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
lparen doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
b doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
rparen
LO (ImmInt Int
i) -> Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
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 -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
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 -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
i doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@l"
HI Imm
i -> Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
i doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@h"
HA (ImmInt Int
i) -> Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
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 -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
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 -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
i doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@ha"
HIGHERA Imm
i -> Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
i doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@highera"
HIGHESTA Imm
i -> Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
i doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> String -> doc
forall doc. IsLine doc => String -> doc
text String
"@highesta"
pprAddr :: IsLine doc => Platform -> AddrMode -> doc
pprAddr :: forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform = \case
AddrRegReg Reg
r1 Reg
r2 -> Reg -> doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
r1 doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
',' doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Reg -> doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
r2
AddrRegImm Reg
r1 (ImmInt Int
i) -> [doc] -> doc
forall doc. IsLine doc => [doc] -> doc
hcat [ Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
i, Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'(', Reg -> doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
r1, Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
')' ]
AddrRegImm Reg
r1 (ImmInteger Integer
i) -> [doc] -> doc
forall doc. IsLine doc => [doc] -> doc
hcat [ Integer -> doc
forall doc. IsLine doc => Integer -> doc
integer Integer
i, Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'(', Reg -> doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
r1, Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
')' ]
AddrRegImm Reg
r1 Imm
imm -> [doc] -> doc
forall doc. IsLine doc => [doc] -> doc
hcat [ Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm, Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'(', Reg -> doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
r1, Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
')' ]
pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
pprSectionAlign :: forall doc. IsDoc doc => NCGConfig -> Section -> doc
pprSectionAlign NCGConfig
config sec :: Section
sec@(Section SectionType
seg CLabel
_) =
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (NCGConfig -> Section -> Line doc
forall doc. IsLine doc => NCGConfig -> Section -> doc
pprSectionHeader NCGConfig
config Section
sec) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
Platform -> SectionType -> doc
forall doc. IsDoc doc => Platform -> SectionType -> doc
pprAlignForSection (NCGConfig -> Platform
ncgPlatform NCGConfig
config) SectionType
seg
pprAlignForSection :: IsDoc doc => Platform -> SectionType -> doc
pprAlignForSection :: forall doc. IsDoc doc => Platform -> SectionType -> doc
pprAlignForSection Platform
platform SectionType
seg = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$
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 -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 2"
SectionType
Data
| Bool
ppc64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 3"
| Bool
otherwise -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 2"
SectionType
ReadOnlyData
| Bool
ppc64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 3"
| Bool
otherwise -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 2"
SectionType
RelocatableReadOnlyData
| Bool
ppc64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 3"
| Bool
otherwise -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 2"
SectionType
UninitialisedData
| Bool
ppc64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 3"
| Bool
otherwise -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 2"
SectionType
InitArray -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 3"
SectionType
FiniArray -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 3"
SectionType
CString
| Bool
ppc64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 3"
| Bool
otherwise -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align 2"
OtherSection String
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PprMach.pprSectionAlign: unknown section"
pprDataItem :: IsDoc doc => Platform -> CmmLit -> doc
pprDataItem :: forall doc. IsDoc doc => Platform -> CmmLit -> doc
pprDataItem Platform
platform CmmLit
lit
= [Line doc] -> doc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ (Format -> CmmLit -> [Line doc]
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 -> [Line doc]
ppr_item Format
II8 CmmLit
_ = [String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.byte\t" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm]
ppr_item Format
II16 CmmLit
_ = [String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.short\t" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm]
ppr_item Format
II32 CmmLit
_ = [String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long\t" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm]
ppr_item Format
II64 CmmLit
_
| Bool
archPPC_64 = [String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.quad\t" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm]
ppr_item Format
II64 (CmmInt Integer
x Width
_)
| Bool -> Bool
not Bool
archPPC_64 =
[String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long\t"
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> Line doc
forall doc. IsLine doc => Int -> doc
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 -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long\t"
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> Line doc
forall doc. IsLine doc => Int -> doc
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 -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.float\t" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm]
ppr_item Format
FF64 CmmLit
_ = [String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.double\t" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm]
ppr_item Format
_ CmmLit
_
= String -> [Line doc]
forall a. HasCallStack => String -> a
panic String
"PPC.Ppr.pprDataItem: no match"
asmComment :: IsLine doc => doc -> doc
doc
c = doc -> doc
forall doc. IsOutput doc => doc -> doc
whenPprDebug (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> doc
forall doc. IsLine doc => String -> doc
text String
"#" doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<+> doc
c
pprInstr :: IsDoc doc => Platform -> Instr -> doc
pprInstr :: forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform Instr
instr = case Instr
instr of
COMMENT FastString
s
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> Line doc
forall doc. IsLine doc => doc -> doc
asmComment (FastString -> Line doc
forall doc. IsLine doc => FastString -> doc
ftext FastString
s))
LOCATION Int
file Int
line' Int
col String
_name
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.loc" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
file Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
line' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
col)
DELTA Int
d
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> Line doc
forall doc. IsLine doc => doc -> doc
asmComment (Line doc -> Line doc) -> Line doc -> Line doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
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 -> doc
forall a. HasCallStack => String -> a
panic String
"PprMach.pprInstr: NEWBLOCK"
LDATA Section
_ RawCmmStatics
_
-> String -> doc
forall a. HasCallStack => String -> a
panic String
"PprMach.pprInstr: LDATA"
LD Format
fmt Reg
reg AddrMode
addr
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"l",
(case Format
fmt of
Format
II8 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"bz"
Format
II16 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"hz"
Format
II32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"wz"
Format
II64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"d"
Format
FF32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fs"
Format
FF64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fd"
VecFormat {} -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC pprInstr: VecFormat"
),
case AddrMode
addr of AddrRegImm Reg
_ Imm
_ -> Line doc
forall doc. IsOutput doc => doc
empty
AddrRegReg Reg
_ Reg
_ -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'x',
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> AddrMode -> Line doc
forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform AddrMode
addr
]
LDFAR Format
fmt Reg
reg (AddrRegImm Reg
source Imm
off)
-> [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat
[ Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform (Reg -> Reg -> Imm -> Instr
ADDIS (Platform -> Reg
tmpReg Platform
platform) Reg
source (Imm -> Imm
HA Imm
off))
, Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
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 -> doc
forall a. HasCallStack => String -> a
panic String
"PPC.Ppr.pprInstr LDFAR: no match"
LDR Format
fmt Reg
reg1 AddrMode
addr
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tl",
case Format
fmt of
Format
II32 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'w'
Format
II64 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'd'
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC.Ppr.Instr LDR: no match",
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"arx\t",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> AddrMode -> Line doc
forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform AddrMode
addr
]
LA Format
fmt Reg
reg AddrMode
addr
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"l",
(case Format
fmt of
Format
II8 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"ba"
Format
II16 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"ha"
Format
II32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"wa"
Format
II64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"d"
Format
FF32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fs"
Format
FF64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fd"
VecFormat {} -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC pprInstr: VecFormat"
),
case AddrMode
addr of AddrRegImm Reg
_ Imm
_ -> Line doc
forall doc. IsOutput doc => doc
empty
AddrRegReg Reg
_ Reg
_ -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'x',
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> AddrMode -> Line doc
forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform AddrMode
addr
]
ST Format
fmt Reg
reg AddrMode
addr
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"st",
Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
fmt,
case AddrMode
addr of AddrRegImm Reg
_ Imm
_ -> Line doc
forall doc. IsOutput doc => doc
empty
AddrRegReg Reg
_ Reg
_ -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'x',
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> AddrMode -> Line doc
forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform AddrMode
addr
]
STFAR Format
fmt Reg
reg (AddrRegImm Reg
source Imm
off)
-> [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [ Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform (Reg -> Reg -> Imm -> Instr
ADDIS (Platform -> Reg
tmpReg Platform
platform) Reg
source (Imm -> Imm
HA Imm
off))
, Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
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 -> doc
forall a. HasCallStack => String -> a
panic String
"PPC.Ppr.pprInstr STFAR: no match"
STU Format
fmt Reg
reg AddrMode
addr
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"st",
Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
fmt,
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'u',
case AddrMode
addr of AddrRegImm Reg
_ Imm
_ -> Line doc
forall doc. IsOutput doc => doc
empty
AddrRegReg Reg
_ Reg
_ -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'x',
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> AddrMode -> Line doc
forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform AddrMode
addr
]
STC Format
fmt Reg
reg1 AddrMode
addr
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tst",
case Format
fmt of
Format
II32 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'w'
Format
II64 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'd'
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC.Ppr.Instr STC: no match",
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cx.\t",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> AddrMode -> Line doc
forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform AddrMode
addr
]
LIS Reg
reg Imm
imm
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"lis",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm
]
LI Reg
reg Imm
imm
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"li",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm
]
MR Reg
reg1 Reg
reg2
| Reg
reg1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg2 -> doc
forall doc. IsOutput doc => doc
empty
| Bool
otherwise -> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
case Platform -> Reg -> RegClass
targetClassOfReg Platform
platform Reg
reg1 of
RegClass
RcInteger -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mr"
RegClass
RcFloatOrVector -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fmr",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2
]
CMP Format
fmt Reg
reg RI
ri
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Line doc
op,
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> RI -> Line doc
forall doc. IsLine doc => Platform -> RI -> doc
pprRI Platform
platform RI
ri
]
where
op :: Line doc
op = [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cmp",
Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
fmt,
case RI
ri of
RIReg Reg
_ -> Line doc
forall doc. IsOutput doc => doc
empty
RIImm Imm
_ -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'i'
]
CMPL Format
fmt Reg
reg RI
ri
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Line doc
op,
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> RI -> Line doc
forall doc. IsLine doc => Platform -> RI -> doc
pprRI Platform
platform RI
ri
]
where
op :: Line doc
op = [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cmpl",
Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
fmt,
case RI
ri of
RIReg Reg
_ -> Line doc
forall doc. IsOutput doc => doc
empty
RIImm Imm
_ -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'i'
]
BCC Cond
cond BlockId
blockid Maybe Bool
prediction
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"b",
Cond -> Line doc
forall doc. IsLine doc => Cond -> doc
pprCond Cond
cond,
Maybe Bool -> Line doc
forall {doc}. IsLine doc => Maybe Bool -> doc
pprPrediction Maybe Bool
prediction,
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel 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 -> doc
pprPrediction Maybe Bool
p = case Maybe Bool
p of
Maybe Bool
Nothing -> doc
forall doc. IsOutput doc => doc
empty
Just Bool
True -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'+'
Just Bool
False -> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
'-'
BCCFAR Cond
cond BlockId
blockid Maybe Bool
prediction
-> [Line doc] -> doc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ [
[Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tb",
Cond -> Line doc
forall doc. IsLine doc => Cond -> doc
pprCond (Cond -> Cond
condNegate Cond
cond),
Line doc
neg_prediction,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t$+8"
],
[Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tb\t",
Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl
]
]
where lbl :: CLabel
lbl = Unique -> CLabel
mkLocalBlockLabel (BlockId -> Unique
forall a. Uniquable a => a -> Unique
getUnique BlockId
blockid)
neg_prediction :: Line doc
neg_prediction = case Maybe Bool
prediction of
Maybe Bool
Nothing -> Line doc
forall doc. IsOutput doc => doc
empty
Just Bool
True -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'-'
Just Bool
False -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'+'
JMP CLabel
lbl [RegWithFormat]
_
| OS
OSAIX <- Platform -> OS
platformOS Platform
platform ->
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tb.\t",
Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl
]
| Bool
otherwise ->
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tb\t",
Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl
]
MTCTR Reg
reg
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mtctr",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg
]
BCTR [Maybe BlockId]
_ Maybe CLabel
_ [RegWithFormat]
_
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"bctr"
]
BL CLabel
lbl [Reg]
_
-> case Platform -> OS
platformOS Platform
platform of
OS
OSAIX ->
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tbl\t.",
Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl
]
OS
_ ->
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tbl\t",
Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lbl
]
BCTRL [Reg]
_
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"bctrl"
]
ADD Reg
reg1 Reg
reg2 RI
ri
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"add") Reg
reg1 Reg
reg2 RI
ri
ADDIS Reg
reg1 Reg
reg2 Imm
imm
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"addis",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm
]
ADDO Reg
reg1 Reg
reg2 Reg
reg3
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"addo") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
ADDC Reg
reg1 Reg
reg2 Reg
reg3
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"addc") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
ADDE Reg
reg1 Reg
reg2 Reg
reg3
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"adde") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
ADDZE Reg
reg1 Reg
reg2
-> Line doc -> Reg -> Reg -> doc
forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"addze") Reg
reg1 Reg
reg2
SUBF Reg
reg1 Reg
reg2 Reg
reg3
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"subf") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
SUBFO Reg
reg1 Reg
reg2 Reg
reg3
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"subfo") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
SUBFC Reg
reg1 Reg
reg2 RI
ri
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"subf",
case RI
ri of
RIReg Reg
_ -> Line doc
forall doc. IsOutput doc => doc
empty
RIImm Imm
_ -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'i',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"c\t",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> RI -> Line doc
forall doc. IsLine doc => Platform -> RI -> doc
pprRI Platform
platform RI
ri
]
SUBFE Reg
reg1 Reg
reg2 Reg
reg3
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
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 -> doc
forall doc.
IsDoc doc =>
Platform -> Format -> Reg -> Reg -> RI -> doc
pprMul Platform
platform Format
fmt Reg
reg1 Reg
reg2 RI
ri
MULLO Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mull",
case Format
fmt of
Format
II32 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'w'
Format
II64 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'd'
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC: illegal format",
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"o\t",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg3
]
MFOV Format
fmt Reg
reg
-> [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat [
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mfxer",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg
],
Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"extr",
case Format
fmt of
Format
II32 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'w'
Format
II64 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'd'
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC: illegal format",
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"i\t",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", 1, ",
case Format
fmt of
Format
II32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"1"
Format
II64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"33"
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC: illegal format"
]
]
MULHU Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mulh",
case Format
fmt of
Format
II32 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'w'
Format
II64 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'd'
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC: illegal format",
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"u\t",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg3
]
DIV Format
fmt Bool
sgn Reg
reg1 Reg
reg2 Reg
reg3
-> Format -> Bool -> Reg -> Reg -> Reg -> doc
forall doc. IsDoc doc => Format -> Bool -> Reg -> Reg -> Reg -> doc
pprDiv Format
fmt Bool
sgn Reg
reg1 Reg
reg2 Reg
reg3
AND Reg
reg1 Reg
reg2 (RIImm Imm
imm)
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"andi.",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm
]
AND Reg
reg1 Reg
reg2 RI
ri
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"and") Reg
reg1 Reg
reg2 RI
ri
ANDC Reg
reg1 Reg
reg2 Reg
reg3
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"andc") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
NAND Reg
reg1 Reg
reg2 Reg
reg3
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"nand") Reg
reg1 Reg
reg2 (Reg -> RI
RIReg Reg
reg3)
OR Reg
reg1 Reg
reg2 RI
ri
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"or") Reg
reg1 Reg
reg2 RI
ri
XOR Reg
reg1 Reg
reg2 RI
ri
-> Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"xor") Reg
reg1 Reg
reg2 RI
ri
ORIS Reg
reg1 Reg
reg2 Imm
imm
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"oris",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm
]
XORIS Reg
reg1 Reg
reg2 Imm
imm
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"xoris",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm
]
EXTS Format
fmt Reg
reg1 Reg
reg2
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"exts",
Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
fmt,
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2
]
CNTLZ Format
fmt Reg
reg1 Reg
reg2
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cntlz",
case Format
fmt of
Format
II32 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'w'
Format
II64 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'd'
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC: illegal format",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2
]
NEG Reg
reg1 Reg
reg2
-> Line doc -> Reg -> Reg -> doc
forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"neg") Reg
reg1 Reg
reg2
NOT Reg
reg1 Reg
reg2
-> Line doc -> Reg -> Reg -> doc
forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"not") Reg
reg1 Reg
reg2
SR Format
II32 Reg
reg1 Reg
reg2 (RIImm (ImmInt Int
i))
| 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 -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
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))
| 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 -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
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))
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31 -> Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
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 :: Line doc
op = case Format
fmt of
Format
II32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"slw"
Format
II64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"sld"
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC.Ppr.pprInstr: shift illegal size"
in Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform Line doc
op Reg
reg1 Reg
reg2 (Format -> RI -> RI
limitShiftRI Format
fmt RI
ri)
SR Format
fmt Reg
reg1 Reg
reg2 RI
ri
-> let op :: Line doc
op = case Format
fmt of
Format
II32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"srw"
Format
II64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"srd"
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC.Ppr.pprInstr: shift illegal size"
in Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform Line doc
op Reg
reg1 Reg
reg2 (Format -> RI -> RI
limitShiftRI Format
fmt RI
ri)
SRA Format
fmt Reg
reg1 Reg
reg2 RI
ri
-> let op :: Line doc
op = case Format
fmt of
Format
II32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"sraw"
Format
II64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"srad"
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC.Ppr.pprInstr: shift illegal size"
in Platform -> Line doc -> Reg -> Reg -> RI -> doc
forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform Line doc
op Reg
reg1 Reg
reg2 (Format -> RI -> RI
limitShiftRI Format
fmt RI
ri)
RLWINM Reg
reg1 Reg
reg2 Int
sh Int
mb Int
me
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\trlwinm\t",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
sh,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
mb,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
me
]
CLRLI Format
fmt Reg
reg1 Reg
reg2 Int
n
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tclrl",
Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
fmt,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"i ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
n
]
CLRRI Format
fmt Reg
reg1 Reg
reg2 Int
n
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tclrr",
Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
fmt,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"i ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
n
]
FADD Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
-> Line doc -> Format -> Reg -> Reg -> Reg -> doc
forall doc.
IsDoc doc =>
Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprBinaryF (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fadd") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
FSUB Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
-> Line doc -> Format -> Reg -> Reg -> Reg -> doc
forall doc.
IsDoc doc =>
Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprBinaryF (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fsub") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
FMUL Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
-> Line doc -> Format -> Reg -> Reg -> Reg -> doc
forall doc.
IsDoc doc =>
Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprBinaryF (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fmul") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
FDIV Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
-> Line doc -> Format -> Reg -> Reg -> Reg -> doc
forall doc.
IsDoc doc =>
Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprBinaryF (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fdiv") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
FABS Reg
reg1 Reg
reg2
-> Line doc -> Reg -> Reg -> doc
forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fabs") Reg
reg1 Reg
reg2
FNEG Reg
reg1 Reg
reg2
-> Line doc -> Reg -> Reg -> doc
forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fneg") Reg
reg1 Reg
reg2
FMIN Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
-> Line doc -> Format -> Reg -> Reg -> Reg -> doc
forall doc.
IsDoc doc =>
Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprBinaryF (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fmin") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
FMAX Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
-> Line doc -> Format -> Reg -> Reg -> Reg -> doc
forall doc.
IsDoc doc =>
Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprBinaryF (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fmax") Format
fmt Reg
reg1 Reg
reg2 Reg
reg3
FMADD FMASign
signs Format
fmt Reg
dst Reg
ra Reg
rc Reg
rb
-> Line doc -> Format -> Reg -> Reg -> Reg -> Reg -> doc
forall doc.
IsDoc doc =>
Line doc -> Format -> Reg -> Reg -> Reg -> Reg -> doc
pprTernaryF (FMASign -> Line doc
forall doc. IsLine doc => FMASign -> doc
pprFMASign FMASign
signs) Format
fmt Reg
dst Reg
ra Reg
rc Reg
rb
FCMP Reg
reg1 Reg
reg2
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fcmpu\t0, ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2
]
FCTIWZ Reg
reg1 Reg
reg2
-> Line doc -> Reg -> Reg -> doc
forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fctiwz") Reg
reg1 Reg
reg2
FCTIDZ Reg
reg1 Reg
reg2
-> Line doc -> Reg -> Reg -> doc
forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fctidz") Reg
reg1 Reg
reg2
FCFID Reg
reg1 Reg
reg2
-> Line doc -> Reg -> Reg -> doc
forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fcfid") Reg
reg1 Reg
reg2
FRSP Reg
reg1 Reg
reg2
-> Line doc -> Reg -> Reg -> doc
forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"frsp") Reg
reg1 Reg
reg2
CRNOR Int
dst Int
src1 Int
src2
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tcrnor\t",
Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
dst,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
src1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
src2
]
MFCR Reg
reg
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mfcr",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg
]
MFLR Reg
reg
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mflr",
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg
]
FETCHPC Reg
reg
-> [Line doc] -> doc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ [
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tbcl\t20,31,1f",
[Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"1:\tmflr\t", Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg ]
]
Instr
HWSYNC
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tsync"
Instr
ISYNC
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tisync"
Instr
LWSYNC
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tlwsync"
Instr
NOP
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tnop"
pprLogic :: IsDoc doc => Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic :: forall doc.
IsDoc doc =>
Platform -> Line doc -> Reg -> Reg -> RI -> doc
pprLogic Platform
platform Line doc
op Reg
reg1 Reg
reg2 RI
ri = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Line doc
op,
case RI
ri of
RIReg Reg
_ -> Line doc
forall doc. IsOutput doc => doc
empty
RIImm Imm
_ -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'i',
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> RI -> Line doc
forall doc. IsLine doc => Platform -> RI -> doc
pprRI Platform
platform RI
ri
]
pprMul :: IsDoc doc => Platform -> Format -> Reg -> Reg -> RI -> doc
pprMul :: forall doc.
IsDoc doc =>
Platform -> Format -> Reg -> Reg -> RI -> doc
pprMul Platform
platform Format
fmt Reg
reg1 Reg
reg2 RI
ri = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mull",
case RI
ri of
RIReg Reg
_ -> case Format
fmt of
Format
II32 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'w'
Format
II64 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'd'
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC: illegal format"
RIImm Imm
_ -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'i',
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Platform -> RI -> Line doc
forall doc. IsLine doc => Platform -> RI -> doc
pprRI Platform
platform RI
ri
]
pprDiv :: IsDoc doc => Format -> Bool -> Reg -> Reg -> Reg -> doc
pprDiv :: forall doc. IsDoc doc => Format -> Bool -> Reg -> Reg -> Reg -> doc
pprDiv Format
fmt Bool
sgn Reg
reg1 Reg
reg2 Reg
reg3 = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"div",
case Format
fmt of
Format
II32 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'w'
Format
II64 -> Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'd'
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"PPC: illegal format",
if Bool
sgn then Line doc
forall doc. IsOutput doc => doc
empty else Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'u',
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg3
]
pprUnary :: IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary :: forall doc. IsDoc doc => Line doc -> Reg -> Reg -> doc
pprUnary Line doc
op Reg
reg1 Reg
reg2 = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Line doc
op,
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2
]
pprBinaryF :: IsDoc doc => Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprBinaryF :: forall doc.
IsDoc doc =>
Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprBinaryF Line doc
op Format
fmt Reg
reg1 Reg
reg2 Reg
reg3 = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Line doc
op,
Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFFormat Format
fmt,
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg1,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg2,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
reg3
]
pprTernaryF :: IsDoc doc => Line doc -> Format -> Reg -> Reg -> Reg -> Reg -> doc
pprTernaryF :: forall doc.
IsDoc doc =>
Line doc -> Format -> Reg -> Reg -> Reg -> Reg -> doc
pprTernaryF Line doc
op Format
fmt Reg
rt Reg
ra Reg
rc Reg
rb = Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> doc) -> Line doc -> doc
forall a b. (a -> b) -> a -> b
$ [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Line doc
op,
Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFFormat Format
fmt,
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t',
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
rt,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
ra,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
rc,
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
", ",
Reg -> Line doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
rb
]
pprRI :: IsLine doc => Platform -> RI -> doc
pprRI :: forall doc. IsLine doc => Platform -> RI -> doc
pprRI Platform
_ (RIReg Reg
r) = Reg -> doc
forall doc. IsLine doc => Reg -> doc
pprReg Reg
r
pprRI Platform
platform (RIImm Imm
r) = Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
r
pprFFormat :: IsLine doc => Format -> doc
pprFFormat :: forall doc. IsLine doc => Format -> doc
pprFFormat Format
FF64 = doc
forall doc. IsOutput doc => doc
empty
pprFFormat Format
FF32 = Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
's'
pprFFormat Format
_ = String -> doc
forall a. HasCallStack => String -> a
panic String
"PPC.Ppr.pprFFormat: no match"
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. HasCallStack => 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. HasCallStack => 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