{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
module GHC.CmmToAsm.X86.Ppr (
pprNatCmmDecl,
pprInstr,
)
where
import GHC.Prelude
import GHC.Platform
import GHC.Platform.Reg
import GHC.CmmToAsm.X86.Regs
import GHC.CmmToAsm.X86.Instr
import GHC.CmmToAsm.X86.Cond
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Format
import GHC.CmmToAsm.Types
import GHC.CmmToAsm.Utils
import GHC.CmmToAsm.Ppr
import GHC.Cmm hiding (topInfoTable)
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.BlockId
import GHC.Cmm.CLabel
import GHC.Cmm.DebugBlock (pprUnwindTable)
import GHC.Types.Basic (Alignment, mkAlignment, alignmentBytes)
import GHC.Types.Unique ( pprUniqueAlways )
import GHC.Utils.Outputable
import GHC.Utils.Panic
import Data.List ( intersperse )
import Data.Word
pprProcAlignment :: IsDoc doc => NCGConfig -> doc
pprProcAlignment :: forall doc. IsDoc doc => NCGConfig -> doc
pprProcAlignment NCGConfig
config = doc -> (Int -> doc) -> Maybe Int -> doc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe doc
forall doc. IsOutput doc => doc
empty (Platform -> Alignment -> doc
forall doc. IsDoc doc => Platform -> Alignment -> doc
pprAlign Platform
platform (Alignment -> doc) -> (Int -> Alignment) -> Int -> doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Alignment
mkAlignment) (NCGConfig -> Maybe Int
ncgProcAlignment NCGConfig
config)
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
pprNatCmmDecl :: IsDoc doc => NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> doc
pprNatCmmDecl :: forall doc.
IsDoc doc =>
NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> doc
pprNatCmmDecl NCGConfig
config (CmmData Section
section (Alignment, 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
$$ NCGConfig -> (Alignment, RawCmmStatics) -> doc
forall doc.
IsDoc doc =>
NCGConfig -> (Alignment, RawCmmStatics) -> doc
pprDatas NCGConfig
config (Alignment, RawCmmStatics)
dats
pprNatCmmDecl NCGConfig
config proc :: NatCmmDecl (Alignment, RawCmmStatics) Instr
proc@(CmmProc LabelMap RawCmmStatics
top_info CLabel
entry_lbl [GlobalRegUse]
_ (ListGraph [GenBasicBlock Instr]
blocks)) =
let platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
top_info_table :: Maybe RawCmmStatics
top_info_table = NatCmmDecl (Alignment, RawCmmStatics) Instr -> Maybe RawCmmStatics
forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable NatCmmDecl (Alignment, RawCmmStatics) Instr
proc
proc_lbl :: CLabel
proc_lbl = case Maybe RawCmmStatics
top_info_table of
Just (CmmStaticsRaw CLabel
info_lbl [CmmStatic]
_) -> CLabel
info_lbl
Maybe RawCmmStatics
Nothing -> CLabel -> CLabel
toProcDelimiterLbl CLabel
entry_lbl
(doc
sub_via_sym_label,doc
sub_via_sym_offset)
| Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
, Just (CmmStaticsRaw CLabel
info_lbl [CmmStatic]
_) <- Maybe RawCmmStatics
top_info_table
, Line doc
info_dsp_lbl <- Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl)
= ( Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc
info_dsp_lbl Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
, 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
"\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
<+> Line doc
info_dsp_lbl
)
| Bool
otherwise = (doc
forall doc. IsOutput doc => doc
empty,doc
forall doc. IsOutput doc => doc
empty)
in [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat
[
NCGConfig -> Section -> doc
forall doc. IsDoc doc => NCGConfig -> Section -> doc
pprSectionAlign NCGConfig
config (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
proc_lbl)
, NCGConfig -> doc
forall doc. IsDoc doc => NCGConfig -> doc
pprProcAlignment NCGConfig
config
, NCGConfig -> CLabel -> doc
forall doc. IsDoc doc => NCGConfig -> CLabel -> doc
pprExposedInternalProcLabel NCGConfig
config CLabel
entry_lbl
, doc
sub_via_sym_label
, case Maybe RawCmmStatics
top_info_table of
Maybe RawCmmStatics
Nothing -> Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabel Platform
platform CLabel
proc_lbl
Just RawCmmStatics
_ -> doc
forall doc. IsOutput doc => doc
empty
, [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)
, Bool -> doc -> doc
forall doc. IsOutput doc => Bool -> doc -> doc
ppWhen (NCGConfig -> Bool
ncgDwarfEnabled NCGConfig
config) (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$ 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
proc_lbl)
, doc
sub_via_sym_offset
, Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprSizeDecl Platform
platform CLabel
proc_lbl
]
{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> SDoc #-}
{-# SPECIALIZE pprNatCmmDecl :: NCGConfig -> NatCmmDecl (Alignment, RawCmmStatics) Instr -> HDoc #-}
pprExposedInternalProcLabel :: IsDoc doc => NCGConfig -> CLabel -> doc
pprExposedInternalProcLabel :: forall doc. IsDoc doc => NCGConfig -> CLabel -> doc
pprExposedInternalProcLabel NCGConfig
config CLabel
lbl
| NCGConfig -> Bool
ncgExposeInternalSymbols NCGConfig
config
, Just Line doc
lbl' <- Module -> CLabel -> Maybe (Line doc)
forall doc. IsLine doc => Module -> CLabel -> Maybe doc
ppInternalProcLabel (NCGConfig -> Module
ncgThisModule NCGConfig
config) CLabel
lbl
= Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc
lbl' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
colon)
| Bool
otherwise
= doc
forall doc. IsOutput doc => doc
empty
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
<> doc
forall doc. IsLine doc => doc
colon
pprBlockEndLabel :: IsLine doc => Platform -> CLabel
-> doc
pprBlockEndLabel :: forall doc. IsLine doc => Platform -> CLabel -> doc
pprBlockEndLabel Platform
platform CLabel
lbl =
Platform -> CLabel -> doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform (CLabel -> CLabel
mkAsmTempEndLabel CLabel
lbl) doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
colon
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
<+> 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
<> 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
lbl)
else doc
forall doc. IsOutput doc => doc
empty
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 -> doc
maybe_infotable (doc -> doc) -> doc -> doc
forall a b. (a -> b) -> a -> b
$
Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprLabel Platform
platform CLabel
block_label 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
pprBlockEndLabel Platform
platform CLabel
block_label) 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
block_label)
)
where
block_label :: CLabel
block_label = BlockId -> CLabel
blockLbl BlockId
blockid
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
maybe_infotable :: doc -> doc
maybe_infotable doc
c = 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
c
Just (CmmStaticsRaw CLabel
infoLbl [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
infoTableLoc 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 (NCGConfig -> CmmStatic -> doc
forall doc. IsDoc doc => NCGConfig -> CmmStatic -> doc
pprData NCGConfig
config) [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
infoLbl doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$
doc
c 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
pprBlockEndLabel Platform
platform CLabel
infoLbl))
infoTableLoc :: doc
infoTableLoc = case [Instr]
instrs of
(l :: Instr
l@LOCATION{} : [Instr]
_) -> Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform Instr
l
[Instr]
_other -> doc
forall doc. IsOutput doc => doc
empty
pprDatas :: IsDoc doc => NCGConfig -> (Alignment, RawCmmStatics) -> doc
pprDatas :: forall doc.
IsDoc doc =>
NCGConfig -> (Alignment, RawCmmStatics) -> doc
pprDatas NCGConfig
config (Alignment
_, 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 (NCGConfig -> Platform
ncgPlatform NCGConfig
config) 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 (NCGConfig -> Platform
ncgPlatform NCGConfig
config) 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 (NCGConfig -> Platform
ncgPlatform NCGConfig
config) CLabel
ind')
pprDatas NCGConfig
config (Alignment
align, (CmmStaticsRaw CLabel
lbl [CmmStatic]
dats))
= [doc] -> doc
forall doc. IsDoc doc => [doc] -> doc
vcat (Platform -> Alignment -> doc
forall doc. IsDoc doc => Platform -> Alignment -> doc
pprAlign Platform
platform Alignment
align doc -> [doc] -> [doc]
forall a. a -> [a] -> [a]
: 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 (NCGConfig -> CmmStatic -> doc
forall doc. IsDoc doc => NCGConfig -> CmmStatic -> doc
pprData NCGConfig
config) [CmmStatic]
dats)
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
pprData :: IsDoc doc => NCGConfig -> CmmStatic -> doc
pprData :: forall doc. IsDoc doc => NCGConfig -> CmmStatic -> doc
pprData NCGConfig
_config (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)
pprData NCGConfig
_config (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)
pprData NCGConfig
config (CmmUninitialised Int
bytes)
= 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 platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
in if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
then 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
else String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".skip " 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
pprData NCGConfig
config (CmmStaticLit CmmLit
lit) = NCGConfig -> CmmLit -> doc
forall doc. IsDoc doc => NCGConfig -> CmmLit -> doc
pprDataItem NCGConfig
config 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)
pprLabelType' :: IsLine doc => Platform -> CLabel -> doc
pprLabelType' :: forall doc. IsLine doc => Platform -> CLabel -> doc
pprLabelType' Platform
platform CLabel
lbl =
if CLabel -> Bool
isCFunctionLabel CLabel
lbl Bool -> Bool -> Bool
|| Bool
functionOkInfoTable then
String -> doc
forall doc. IsLine doc => String -> doc
text String
"@function"
else
String -> doc
forall doc. IsLine doc => String -> doc
text String
"@object"
where
functionOkInfoTable :: Bool
functionOkInfoTable = Platform -> Bool
platformTablesNextToCode Platform
platform Bool -> Bool -> Bool
&&
CLabel -> Bool
isInfoTableLabel CLabel
lbl Bool -> Bool -> Bool
&& Bool -> Bool
not (CLabel -> Bool
isCmmInfoTableLabel CLabel
lbl) Bool -> Bool -> Bool
&& Bool -> Bool
not (CLabel -> Bool
isConInfoTableLabel CLabel
lbl)
pprTypeDecl :: IsDoc doc => Platform -> CLabel -> doc
pprTypeDecl :: forall doc. IsDoc doc => Platform -> CLabel -> doc
pprTypeDecl Platform
platform CLabel
lbl
= if OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform) Bool -> Bool -> Bool
&& CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
then 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
lbl 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
pprLabelType' Platform
platform CLabel
lbl)
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
$$ Platform -> CLabel -> doc
forall doc. IsDoc doc => Platform -> CLabel -> doc
pprTypeDecl 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
<> Line doc
forall doc. IsLine doc => doc
colon)
pprAlign :: IsDoc doc => Platform -> Alignment -> doc
pprAlign :: forall doc. IsDoc doc => Platform -> Alignment -> doc
pprAlign Platform
platform Alignment
alignment
= 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
".align " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int (Platform -> Int
alignmentOn Platform
platform)
where
bytes :: Int
bytes = Alignment -> Int
alignmentBytes Alignment
alignment
alignmentOn :: Platform -> Int
alignmentOn Platform
platform = if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
then Int -> Int
log2 Int
bytes
else Int
bytes
log2 :: Int -> Int
log2 :: Int -> Int
log2 Int
1 = Int
0
log2 Int
2 = Int
1
log2 Int
4 = Int
2
log2 Int
8 = Int
3
log2 Int
n = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int
log2 (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2)
pprReg :: forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg :: forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
f Reg
r
= case Reg
r of
RegReal (RealRegSingle Int
i) ->
if Platform -> Bool
target32Bit Platform
platform then Format -> Int -> doc
ppr32_reg_no Format
f Int
i
else Format -> Int -> doc
ppr64_reg_no Format
f 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
ppr32_reg_no :: Format -> Int -> doc
ppr32_reg_no :: Format -> Int -> doc
ppr32_reg_no Format
II8 = Int -> doc
forall doc. IsLine doc => Int -> doc
ppr32_reg_byte
ppr32_reg_no Format
II16 = Int -> doc
forall {a} {doc}. (Eq a, Num a, IsLine doc) => a -> doc
ppr32_reg_word
ppr32_reg_no Format
fmt = Format -> Int -> doc
forall {doc}. IsLine doc => Format -> Int -> doc
ppr32_reg_long Format
fmt
ppr32_reg_byte :: Int -> doc
ppr32_reg_byte Int
i =
case Int
i of {
Int
0 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%al"; Int
1 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%bl";
Int
2 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%cl"; Int
3 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%dl";
Int
_ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"very naughty I386 byte register: " doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
i
}
ppr32_reg_word :: a -> doc
ppr32_reg_word a
i =
case a
i of {
a
0 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ax"; a
1 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%bx";
a
2 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%cx"; a
3 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%dx";
a
4 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%si"; a
5 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%di";
a
6 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%bp"; a
7 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%sp";
a
_ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"very naughty I386 word register"
}
ppr32_reg_long :: Format -> Int -> doc
ppr32_reg_long Format
fmt Int
i =
case Int
i of {
Int
0 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%eax"; Int
1 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ebx";
Int
2 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ecx"; Int
3 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%edx";
Int
4 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%esi"; Int
5 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%edi";
Int
6 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ebp"; Int
7 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%esp";
Int
_ -> Format -> Int -> doc
forall {doc}. IsLine doc => Format -> Int -> doc
ppr_reg_float Format
fmt Int
i
}
ppr64_reg_no :: Format -> Int -> doc
ppr64_reg_no :: Format -> Int -> doc
ppr64_reg_no Format
II8 = Int -> doc
forall doc. IsLine doc => Int -> doc
ppr64_reg_byte
ppr64_reg_no Format
II16 = Int -> doc
forall {a} {doc}. (Eq a, Num a, IsLine doc) => a -> doc
ppr64_reg_word
ppr64_reg_no Format
II32 = Int -> doc
forall {a} {doc}. (Eq a, Num a, IsLine doc) => a -> doc
ppr64_reg_long
ppr64_reg_no Format
fmt = Format -> Int -> doc
forall {doc}. IsLine doc => Format -> Int -> doc
ppr64_reg_quad Format
fmt
ppr64_reg_byte :: Int -> doc
ppr64_reg_byte Int
i =
case Int
i of {
Int
0 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%al"; Int
1 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%bl";
Int
2 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%cl"; Int
3 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%dl";
Int
4 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%sil"; Int
5 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%dil";
Int
6 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%bpl"; Int
7 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%spl";
Int
8 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r8b"; Int
9 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r9b";
Int
10 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r10b"; Int
11 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r11b";
Int
12 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r12b"; Int
13 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r13b";
Int
14 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r14b"; Int
15 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r15b";
Int
_ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"very naughty x86_64 byte register: " doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
i
}
ppr64_reg_word :: a -> doc
ppr64_reg_word a
i =
case a
i of {
a
0 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ax"; a
1 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%bx";
a
2 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%cx"; a
3 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%dx";
a
4 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%si"; a
5 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%di";
a
6 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%bp"; a
7 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%sp";
a
8 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r8w"; a
9 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r9w";
a
10 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r10w"; a
11 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r11w";
a
12 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r12w"; a
13 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r13w";
a
14 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r14w"; a
15 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r15w";
a
_ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"very naughty x86_64 word register"
}
ppr64_reg_long :: a -> doc
ppr64_reg_long a
i =
case a
i of {
a
0 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%eax"; a
1 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ebx";
a
2 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ecx"; a
3 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%edx";
a
4 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%esi"; a
5 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%edi";
a
6 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ebp"; a
7 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%esp";
a
8 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r8d"; a
9 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r9d";
a
10 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r10d"; a
11 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r11d";
a
12 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r12d"; a
13 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r13d";
a
14 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r14d"; a
15 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r15d";
a
_ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"very naughty x86_64 register"
}
ppr64_reg_quad :: Format -> Int -> doc
ppr64_reg_quad Format
fmt Int
i =
case Int
i of {
Int
0 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%rax"; Int
1 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%rbx";
Int
2 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%rcx"; Int
3 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%rdx";
Int
4 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%rsi"; Int
5 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%rdi";
Int
6 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%rbp"; Int
7 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%rsp";
Int
8 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r8"; Int
9 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r9";
Int
10 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r10"; Int
11 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r11";
Int
12 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r12"; Int
13 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r13";
Int
14 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r14"; Int
15 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%r15";
Int
_ -> Format -> Int -> doc
forall {doc}. IsLine doc => Format -> Int -> doc
ppr_reg_float Format
fmt Int
i
}
ppr_reg_float :: IsLine doc => Format -> Int -> doc
ppr_reg_float :: forall {doc}. IsLine doc => Format -> Int -> doc
ppr_reg_float Format
fmt Int
i
| Width
W256 <- Width
size
= case Int
i of
Int
16 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm0" ; Int
17 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm1"
Int
18 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm2" ; Int
19 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm3"
Int
20 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm4" ; Int
21 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm5"
Int
22 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm6" ; Int
23 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm7"
Int
24 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm8" ; Int
25 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm9"
Int
26 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm10"; Int
27 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm11"
Int
28 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm12"; Int
29 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm13"
Int
30 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm14"; Int
31 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%ymm15"
Int
_ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"very naughty x86 register"
| Width
W512 <- Width
size
= case Int
i of
Int
16 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm0" ; Int
17 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm1"
Int
18 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm2" ; Int
19 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm3"
Int
20 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm4" ; Int
21 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm5"
Int
22 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm6" ; Int
23 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm7"
Int
24 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm8" ; Int
25 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm9"
Int
26 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm10"; Int
27 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm11"
Int
28 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm12"; Int
29 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm13"
Int
30 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm14"; Int
31 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%zmm15"
Int
_ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"very naughty x86 register"
| Bool
otherwise
= case Int
i of
Int
16 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm0" ; Int
17 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm1"
Int
18 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm2" ; Int
19 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm3"
Int
20 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm4" ; Int
21 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm5"
Int
22 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm6" ; Int
23 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm7"
Int
24 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm8" ; Int
25 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm9"
Int
26 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm10"; Int
27 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm11"
Int
28 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm12"; Int
29 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm13"
Int
30 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm14"; Int
31 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"%xmm15"
Int
_ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"very naughty x86 register"
where size :: Width
size = Format -> Width
formatToWidth Format
fmt
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
"w"
Format
II32 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"l"
Format
II64 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"q"
Format
FF32 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ss"
Format
FF64 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"sd"
VecFormat Int
_ ScalarFormat
FmtFloat -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ps"
VecFormat Int
_ ScalarFormat
FmtDouble -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"pd"
VecFormat Int
_ ScalarFormat
FmtInt8 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"b"
VecFormat Int
_ ScalarFormat
FmtInt16 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"w"
VecFormat Int
_ ScalarFormat
FmtInt32 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"l"
VecFormat Int
_ ScalarFormat
FmtInt64 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"q"
pprFormat_x87 :: IsLine doc => Format -> doc
pprFormat_x87 :: forall doc. IsLine doc => Format -> doc
pprFormat_x87 Format
x = case Format
x of
Format
FF32 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"s"
Format
FF64 -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"l"
Format
_ -> String -> doc
forall a. HasCallStack => String -> a
panic String
"X86.Ppr.pprFormat_x87"
pprCond :: IsLine doc => Cond -> doc
pprCond :: forall doc. IsLine doc => Cond -> doc
pprCond Cond
c = case Cond
c of {
Cond
GEU -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ae"; Cond
LU -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"b";
Cond
EQQ -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"e"; Cond
GTT -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"g";
Cond
GE -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ge"; Cond
GU -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"a";
Cond
LTT -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"l"; Cond
LE -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"le";
Cond
LEU -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"be"; Cond
NE -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ne";
Cond
NEG -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"s"; Cond
POS -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"ns";
Cond
CARRY -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"c"; Cond
OFLO -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"o";
Cond
PARITY -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"p"; Cond
NOTPARITY -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"np";
Cond
ALWAYS -> String -> doc
forall doc. IsLine doc => String -> doc
text String
"mp"}
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
pprAddr :: IsLine doc => Platform -> AddrMode -> doc
pprAddr :: forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform (ImmAddr Imm
imm Int
off)
= let pp_imm :: doc
pp_imm = Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm
in
if (Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) then
doc
pp_imm
else if (Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) then
doc
pp_imm doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
off
else
doc
pp_imm 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
off
pprAddr Platform
platform (AddrBaseIndex EABase
base EAIndex
index Imm
displacement)
= let
pp_disp :: doc
pp_disp = Imm -> doc
ppr_disp Imm
displacement
pp_off :: doc -> doc
pp_off doc
p = doc
pp_disp 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
p doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> doc
forall doc. IsLine doc => Char -> doc
char Char
')'
pp_reg :: Reg -> doc
pp_reg Reg
r = Platform -> Format -> Reg -> doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
r
in
case (EABase
base, EAIndex
index) of
(EABase
EABaseNone, EAIndex
EAIndexNone) -> doc
pp_disp
(EABaseReg Reg
b, EAIndex
EAIndexNone) -> doc -> doc
pp_off (Reg -> doc
pp_reg Reg
b)
(EABase
EABaseRip, EAIndex
EAIndexNone) -> doc -> doc
pp_off (String -> doc
forall doc. IsLine doc => String -> doc
text String
"%rip")
(EABase
EABaseNone, EAIndex Reg
r Int
i) -> doc -> doc
pp_off (doc
forall doc. IsLine doc => doc
comma doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Reg -> doc
pp_reg Reg
r doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
comma doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
i)
(EABaseReg Reg
b, EAIndex Reg
r Int
i) -> doc -> doc
pp_off (Reg -> doc
pp_reg Reg
b doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
comma doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Reg -> doc
pp_reg Reg
r
doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> doc
forall doc. IsLine doc => doc
comma doc -> doc -> doc
forall doc. IsLine doc => doc -> doc -> doc
<> Int -> doc
forall doc. IsLine doc => Int -> doc
int Int
i)
(EABase, EAIndex)
_ -> String -> doc
forall a. HasCallStack => String -> a
panic String
"X86.Ppr.pprAddr: no match"
where
ppr_disp :: Imm -> doc
ppr_disp (ImmInt Int
0) = doc
forall doc. IsOutput doc => doc
empty
ppr_disp Imm
imm = Platform -> Imm -> doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm
pprSectionAlign :: IsDoc doc => NCGConfig -> Section -> doc
pprSectionAlign :: forall doc. IsDoc doc => NCGConfig -> Section -> doc
pprSectionAlign NCGConfig
_config (Section (OtherSection String
_) CLabel
_) =
String -> doc
forall a. HasCallStack => String -> a
panic String
"X86.Ppr.pprSectionAlign: unknown section"
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
$
String -> Line doc
forall doc. IsLine doc => String -> doc
text String
".align " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<>
case Platform -> OS
platformOS Platform
platform of
OS
OSDarwin
| Platform -> Bool
target32Bit Platform
platform ->
case SectionType
seg of
SectionType
CString -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
1
SectionType
_ -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
2
| Bool
otherwise ->
case SectionType
seg of
SectionType
CString -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
1
SectionType
_ -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
3
OS
_
| Platform -> Bool
target32Bit Platform
platform ->
case SectionType
seg of
SectionType
Text -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"4,0x90"
SectionType
CString -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
1
SectionType
_ -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
4
| Bool
otherwise ->
case SectionType
seg of
SectionType
CString -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
1
SectionType
_ -> Int -> Line doc
forall doc. IsLine doc => Int -> doc
int Int
8
pprDataItem :: forall doc. IsDoc doc => NCGConfig -> CmmLit -> doc
pprDataItem :: forall doc. IsDoc doc => NCGConfig -> CmmLit -> doc
pprDataItem NCGConfig
config CmmLit
lit =
let (Line doc
itemFmt, CmmLit -> [Line doc]
items) = Format -> (Line doc, CmmLit -> [Line doc])
itemFormatAndItems (CmmType -> Format
cmmTypeFormat (CmmType -> Format) -> CmmType -> Format
forall a b. (a -> b) -> a -> b
$ Platform -> CmmLit -> CmmType
cmmLitType Platform
platform CmmLit
lit)
in 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
itemFmt Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hsep (Line doc -> [Line doc] -> [Line doc]
forall doc. IsLine doc => doc -> [doc] -> [doc]
punctuate Line doc
forall doc. IsLine doc => doc
comma (CmmLit -> [Line doc]
items CmmLit
lit))
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
pprLitImm, pprII64AsII32x2 :: CmmLit -> [Line doc]
pprLitImm :: CmmLit -> [Line doc]
pprLitImm = (Line doc -> [Line doc] -> [Line doc]
forall a. a -> [a] -> [a]
:[]) (Line doc -> [Line doc])
-> (CmmLit -> Line doc) -> CmmLit -> [Line doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform (Imm -> Line doc) -> (CmmLit -> Imm) -> CmmLit -> Line doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CmmLit -> Imm
litToImm
pprII64AsII32x2 :: CmmLit -> [Line doc]
pprII64AsII32x2 (CmmInt Integer
x Width
_)
= [ 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))
, 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)) ]
pprII64AsII32x2 CmmLit
x
= String -> SDoc -> [Line doc]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"X86 pprDataItem II64" (CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
x)
itemFormatAndItems :: Format -> (Line doc, CmmLit -> [Line doc])
itemFormatAndItems :: Format -> (Line doc, CmmLit -> [Line doc])
itemFormatAndItems = \case
Format
II8 -> ( String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.byte\t", CmmLit -> [Line doc]
pprLitImm )
Format
II16 -> ( String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.word\t", CmmLit -> [Line doc]
pprLitImm )
Format
II32 -> ( String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long\t", CmmLit -> [Line doc]
pprLitImm )
Format
II64 ->
case Platform -> OS
platformOS Platform
platform of
OS
OSDarwin
| Platform -> Bool
target32Bit Platform
platform
-> ( String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.long\t", CmmLit -> [Line doc]
pprII64AsII32x2 )
OS
_ -> ( String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.quad\t", CmmLit -> [Line doc]
pprLitImm )
Format
FF32 -> ( String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.float\t", CmmLit -> [Line doc]
pprLitImm )
Format
FF64 -> ( String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\t.double\t", CmmLit -> [Line doc]
pprLitImm )
VecFormat Int
_ ScalarFormat
sFmt ->
let (Line doc
fmtTxt, CmmLit -> [Line doc]
pprElt) = Format -> (Line doc, CmmLit -> [Line doc])
itemFormatAndItems (ScalarFormat -> Format
scalarFormatFormat ScalarFormat
sFmt)
in (Line doc
fmtTxt, \ case { CmmVec [CmmLit]
elts -> CmmLit -> [Line doc]
pprElt (CmmLit -> [Line doc]) -> [CmmLit] -> [Line doc]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [CmmLit]
elts
; CmmLit
x -> String -> SDoc -> [Line doc]
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"X86 pprDataItem VecFormat" (CmmLit -> SDoc
forall a. Outputable a => a -> SDoc
ppr CmmLit
x)
})
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 :: forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr :: forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform Instr
i = case Instr
i 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
"pprInstr: NEWBLOCK"
UNWIND CLabel
lbl UnwindTable
d
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (Line doc -> Line doc
forall doc. IsLine doc => doc -> doc
asmComment (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tunwind = " Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> UnwindTable -> Line doc
forall doc. IsLine doc => Platform -> UnwindTable -> doc
pprUnwindTable Platform
platform UnwindTable
d))
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
<> Line doc
forall doc. IsLine doc => doc
colon)
LDATA Section
_ (Alignment, RawCmmStatics)
_
-> String -> doc
forall a. HasCallStack => String -> a
panic String
"pprInstr: LDATA"
MOV Format
format (OpImm (ImmInt Int
0)) dst :: Operand
dst@(OpReg Reg
_)
-> Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform (Format -> Operand -> Operand -> Instr
XOR Format
format' Operand
dst Operand
dst)
where format' :: Format
format' = case Format
format of
Format
II64 -> Format
II32
Format
_ -> Format
format
MOV Format
fmt Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mov") Format
fmt' Operand
src Operand
dst
where
fmt' :: Format
fmt' = case Format
fmt of
VecFormat Int
_l ScalarFormat
sFmt -> ScalarFormat -> Format
scalarFormatFormat ScalarFormat
sFmt
Format
_ -> Format
fmt
CMOV Cond
cc Format
format Operand
src Reg
dst
-> Line doc -> Format -> Cond -> Operand -> Reg -> doc
pprCondOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cmov") Format
format Cond
cc Operand
src Reg
dst
MOVD Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprMovdOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mov") Format
format Operand
src Operand
dst
MOVZxL Format
II32 Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mov") Format
II32 Operand
src Operand
dst
MOVZxL Format
formats Operand
src Operand
dst
-> Line doc -> Format -> Format -> Operand -> Operand -> doc
pprFormatOpOpCoerce (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"movz") Format
formats Format
II32 Operand
src Operand
dst
MOVSxL Format
formats Operand
src Operand
dst
-> Line doc -> Format -> Format -> Operand -> Operand -> doc
pprFormatOpOpCoerce (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"movs") Format
formats (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Operand
src Operand
dst
LEA Format
format (OpAddr (AddrBaseIndex (EABaseReg Reg
reg1) (EAIndex Reg
reg2 Int
1) (ImmInt Int
0))) dst :: Operand
dst@(OpReg Reg
reg3)
| Reg
reg1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg3
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"add") Format
format (Reg -> Operand
OpReg Reg
reg2) Operand
dst
LEA Format
format (OpAddr (AddrBaseIndex (EABaseReg Reg
reg1) (EAIndex Reg
reg2 Int
1) (ImmInt Int
0))) dst :: Operand
dst@(OpReg Reg
reg3)
| Reg
reg2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg3
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"add") Format
format (Reg -> Operand
OpReg Reg
reg1) Operand
dst
LEA Format
format (OpAddr (AddrBaseIndex (EABaseReg Reg
reg1) EAIndex
EAIndexNone Imm
displ)) dst :: Operand
dst@(OpReg Reg
reg3)
| Reg
reg1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
reg3
-> Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform (Format -> Operand -> Operand -> Instr
ADD Format
format (Imm -> Operand
OpImm Imm
displ) Operand
dst)
LEA Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"lea") Format
format Operand
src Operand
dst
ADD Format
format (OpImm (ImmInt (-1))) Operand
dst
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"dec") Format
format Operand
dst
ADD Format
format (OpImm (ImmInt Int
1)) Operand
dst
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"inc") Format
format Operand
dst
ADD Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"add") Format
format Operand
src Operand
dst
ADC Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"adc") Format
format Operand
src Operand
dst
SUB Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"sub") Format
format Operand
src Operand
dst
SBB Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"sbb") Format
format Operand
src Operand
dst
IMUL Format
format Operand
op1 Operand
op2
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"imul") Format
format Operand
op1 Operand
op2
ADD_CC Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"add") Format
format Operand
src Operand
dst
SUB_CC Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"sub") Format
format Operand
src Operand
dst
AND Format
II64 src :: Operand
src@(OpImm (ImmInteger Integer
mask)) Operand
dst
| Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mask Bool -> Bool -> Bool
&& Integer
mask Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0xffffffff
-> Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform (Format -> Operand -> Operand -> Instr
AND Format
II32 Operand
src Operand
dst)
AND Format
FF32 Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"andps") Format
FF32 Operand
src Operand
dst
AND Format
FF64 Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"andpd") Format
FF64 Operand
src Operand
dst
AND Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"and") Format
format Operand
src Operand
dst
OR Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"or") Format
format Operand
src Operand
dst
XOR Format
FF32 Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"xorps") Format
FF32 Operand
src Operand
dst
XOR Format
FF64 Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"xorpd") Format
FF64 Operand
src Operand
dst
XOR format :: Format
format@(VecFormat Int
_ ScalarFormat
sfmt) Operand
src Operand
dst | ScalarFormat -> Bool
isIntScalarFormat ScalarFormat
sfmt
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"pxor") Format
format Operand
src Operand
dst
XOR Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"xor") Format
format Operand
src Operand
dst
VXOR Format
fmt Operand
src1 Reg
src2 Reg
dst
-> Format -> Operand -> Reg -> Reg -> doc
pprVxor Format
fmt Operand
src1 Reg
src2 Reg
dst
POPCNT Format
format Operand
src Reg
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"popcnt") Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
LZCNT Format
format Operand
src Reg
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"lzcnt") Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
TZCNT Format
format Operand
src Reg
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"tzcnt") Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
BSF Format
format Operand
src Reg
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"bsf") Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
BSR Format
format Operand
src Reg
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"bsr") Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
PDEP Format
format Operand
src Operand
mask Reg
dst
-> Line doc -> Format -> Operand -> Operand -> Reg -> doc
pprFormatOpOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"pdep") Format
format Operand
src Operand
mask Reg
dst
PEXT Format
format Operand
src Operand
mask Reg
dst
-> Line doc -> Format -> Operand -> Operand -> Reg -> doc
pprFormatOpOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"pext") Format
format Operand
src Operand
mask Reg
dst
PREFETCH PrefetchVariant
NTA Format
format Operand
src
-> Line doc -> Format -> Operand -> doc
pprFormatOp_ (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"prefetchnta") Format
format Operand
src
PREFETCH PrefetchVariant
Lvl0 Format
format Operand
src
-> Line doc -> Format -> Operand -> doc
pprFormatOp_ (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"prefetcht0") Format
format Operand
src
PREFETCH PrefetchVariant
Lvl1 Format
format Operand
src
-> Line doc -> Format -> Operand -> doc
pprFormatOp_ (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"prefetcht1") Format
format Operand
src
PREFETCH PrefetchVariant
Lvl2 Format
format Operand
src
-> Line doc -> Format -> Operand -> doc
pprFormatOp_ (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"prefetcht2") Format
format Operand
src
NOT Format
format Operand
op
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"not") Format
format Operand
op
BSWAP Format
format Reg
op
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"bswap") Format
format (Reg -> Operand
OpReg Reg
op)
NEGI Format
format Operand
op
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"neg") Format
format Operand
op
SHL Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprShift (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"shl") Format
format Operand
src Operand
dst
SAR Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprShift (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"sar") Format
format Operand
src Operand
dst
SHR Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprShift (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"shr") Format
format Operand
src Operand
dst
SHLD Format
format Operand
src Operand
dst1 Operand
dst2
-> Line doc -> Format -> Operand -> Operand -> Operand -> doc
pprShift2 (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"shld") Format
format Operand
src Operand
dst1 Operand
dst2
SHRD Format
format Operand
src Operand
dst1 Operand
dst2
-> Line doc -> Format -> Operand -> Operand -> Operand -> doc
pprShift2 (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"shrd") Format
format Operand
src Operand
dst1 Operand
dst2
BT Format
format Imm
imm Operand
src
-> Line doc -> Format -> Imm -> Operand -> doc
pprFormatImmOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"bt") Format
format Imm
imm Operand
src
CMP Format
format Operand
src Operand
dst
| Format -> Bool
isFloatFormat Format
format -> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"ucomi") Format
format Operand
src Operand
dst
| Bool
otherwise -> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cmp") Format
format Operand
src Operand
dst
TEST Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"test") Format
format' Operand
src Operand
dst
where
format' :: Format
format' = case (Operand
src,Operand
dst) of
(OpImm (ImmInteger Integer
mask), OpReg Reg
dstReg)
| Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
mask Bool -> Bool -> Bool
&& Integer
mask Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
128 -> Platform -> Reg -> Format
minSizeOfReg Platform
platform Reg
dstReg
(Operand, Operand)
_ -> Format
format
minSizeOfReg :: Platform -> Reg -> Format
minSizeOfReg Platform
platform (RegReal (RealRegSingle Int
i))
| Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
3 = Format
II8
| Platform -> Bool
target32Bit Platform
platform Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
7 = Format
II16
| Bool -> Bool
not (Platform -> Bool
target32Bit Platform
platform) Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
15 = Format
II8
minSizeOfReg Platform
_ Reg
_ = Format
format
PUSH Format
format Operand
op
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"push") Format
format Operand
op
POP Format
format Operand
op
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"pop") Format
format Operand
op
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"
CLTD Format
II8
-> 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
"\tcbtw"
CLTD Format
II16
-> 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
"\tcwtd"
CLTD Format
II32
-> 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
"\tcltd"
CLTD Format
II64
-> 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
"\tcqto"
CLTD Format
x
-> String -> doc
forall a. HasCallStack => String -> a
panic (String -> doc) -> String -> doc
forall a b. (a -> b) -> a -> b
$ String
"pprInstr: CLTD " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Format -> String
forall a. Show a => a -> String
show Format
x
SETCC Cond
cond Operand
op
-> Line doc -> Cond -> Line doc -> doc
pprCondInstr (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"set") Cond
cond (Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
II8 Operand
op)
XCHG Format
format Operand
src Reg
val
-> Line doc -> Format -> Operand -> Reg -> doc
pprFormatOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"xchg") Format
format Operand
src Reg
val
JXX Cond
cond BlockId
blockid
-> Line doc -> Cond -> Line doc -> doc
pprCondInstr (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"j") Cond
cond (Platform -> CLabel -> Line doc
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform CLabel
lab)
where lab :: CLabel
lab = BlockId -> CLabel
blockLbl BlockId
blockid
JXX_GBL Cond
cond Imm
imm
-> Line doc -> Cond -> Line doc -> doc
pprCondInstr (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"j") Cond
cond (Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm)
JMP (OpImm Imm
imm) [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
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tjmp " 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
JMP Operand
op [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
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tjmp *" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Operand
op
JMP_TBL Operand
op [Maybe JumpDest]
_ Section
_ CLabel
_
-> Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform (Operand -> [RegWithFormat] -> Instr
JMP Operand
op [])
CALL (Left Imm
imm) [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
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tcall " 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
CALL (Right Reg
reg) [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
$ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tcall *" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg
IDIV Format
fmt Operand
op
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"idiv") Format
fmt Operand
op
DIV Format
fmt Operand
op
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"div") Format
fmt Operand
op
IMUL2 Format
fmt Operand
op
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"imul") Format
fmt Operand
op
MUL Format
format Operand
op1 Operand
op2
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mul") Format
format Operand
op1 Operand
op2
MUL2 Format
format Operand
op
-> Line doc -> Format -> Operand -> doc
pprFormatOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"mul") Format
format Operand
op
FDIV Format
format Operand
op1 Operand
op2
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"div") Format
format Operand
op1 Operand
op2
FMA3 Format
format FMASign
var FMAPermutation
perm Operand
op1 Reg
op2 Reg
op3
-> let mnemo :: Line doc
mnemo = case FMASign
var of
FMASign
FMAdd -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vfmadd"
FMASign
FMSub -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vfmsub"
FMASign
FNMAdd -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vfnmadd"
FMASign
FNMSub -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vfnmsub"
in Line doc -> Format -> Operand -> Reg -> Reg -> doc
pprFormatOpRegReg (Line doc
mnemo Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> FMAPermutation -> Line doc
pprFMAPermutation FMAPermutation
perm) Format
format Operand
op1 Reg
op2 Reg
op3
SQRT Format
format Operand
op1 Reg
op2
-> Line doc -> Format -> Operand -> Reg -> doc
pprFormatOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"sqrt") Format
format Operand
op1 Reg
op2
CVTSS2SD Reg
from Reg
to
-> Line doc -> Reg -> Reg -> doc
pprRegReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cvtss2sd") Reg
from Reg
to
CVTSD2SS Reg
from Reg
to
-> Line doc -> Reg -> Reg -> doc
pprRegReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cvtsd2ss") Reg
from Reg
to
CVTTSS2SIQ Format
fmt Operand
from Reg
to
-> Line doc -> Format -> Format -> Operand -> Reg -> doc
pprFormatFormatOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cvttss2si") Format
FF32 Format
fmt Operand
from Reg
to
CVTTSD2SIQ Format
fmt Operand
from Reg
to
-> Line doc -> Format -> Format -> Operand -> Reg -> doc
pprFormatFormatOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cvttsd2si") Format
FF64 Format
fmt Operand
from Reg
to
CVTSI2SS Format
fmt Operand
from Reg
to
-> Line doc -> Format -> Operand -> Reg -> doc
pprFormatOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cvtsi2ss") Format
fmt Operand
from Reg
to
CVTSI2SD Format
fmt Operand
from Reg
to
-> Line doc -> Format -> Operand -> Reg -> doc
pprFormatOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cvtsi2sd") Format
fmt Operand
from Reg
to
FETCHGOT Reg
reg
-> [Line doc] -> doc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ [ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tcall 1f",
[Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"1:\tpopl\t", Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
II32 Reg
reg ],
[Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), ",
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
II32 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
"\tcall 1f",
[Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [ String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"1:\tpopl\t", Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
II32 Reg
reg ]
]
g :: Instr
g@(X87Store Format
fmt AddrMode
addr)
-> Instr -> Line doc -> doc
pprX87 Instr
g ([Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [Line doc
gtab, String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"fstp", Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat_x87 Format
fmt, Line doc
gsp, Platform -> AddrMode -> Line doc
forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform AddrMode
addr])
LOCK Instr
i
-> Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"\tlock") doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Platform -> Instr -> doc
forall doc. IsDoc doc => Platform -> Instr -> doc
pprInstr Platform
platform Instr
i
Instr
MFENCE
-> 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
"\tmfence"
XADD Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"xadd") Format
format Operand
src Operand
dst
CMPXCHG Format
format Operand
src Operand
dst
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"cmpxchg") Format
format Operand
src Operand
dst
VADD Format
format Operand
s1 Reg
s2 Reg
dst
-> Line doc -> Format -> Operand -> Reg -> Reg -> doc
pprFormatOpRegReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vadd") Format
format Operand
s1 Reg
s2 Reg
dst
VSUB Format
format Operand
s1 Reg
s2 Reg
dst
-> Line doc -> Format -> Operand -> Reg -> Reg -> doc
pprFormatOpRegReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vsub") Format
format Operand
s1 Reg
s2 Reg
dst
VMUL Format
format Operand
s1 Reg
s2 Reg
dst
-> Line doc -> Format -> Operand -> Reg -> Reg -> doc
pprFormatOpRegReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vmul") Format
format Operand
s1 Reg
s2 Reg
dst
VDIV Format
format Operand
s1 Reg
s2 Reg
dst
-> Line doc -> Format -> Operand -> Reg -> Reg -> doc
pprFormatOpRegReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vdiv") Format
format Operand
s1 Reg
s2 Reg
dst
VBROADCAST Format
format Operand
from Reg
to
-> Line doc -> Format -> Operand -> Reg -> doc
pprBroadcast (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vbroadcast") Format
format Operand
from Reg
to
VMOVU Format
format Operand
from Operand
to
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vmovu") Format
format Operand
from Operand
to
MOVU Format
format Operand
from Operand
to
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"movu") Format
format Operand
from Operand
to
MOVL Format
format Operand
from Operand
to
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"movl") Format
format Operand
from Operand
to
MOVH Format
format Operand
from Operand
to
-> Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"movh") Format
format Operand
from Operand
to
MOVDQU Format
format Operand
from Operand
to
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"movdqu") Format
format Operand
from Operand
to
VMOVDQU Format
format Operand
from Operand
to
-> Line doc -> Format -> Operand -> Operand -> doc
pprOpOp Line doc
vmovdqu_op Format
format Operand
from Operand
to
where
vmovdqu_op :: Line doc
vmovdqu_op = case Format
format of
VecFormat Int
8 ScalarFormat
FmtInt64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vmovdqu64"
VecFormat Int
16 ScalarFormat
FmtInt32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vmovdqu32"
VecFormat Int
32 ScalarFormat
FmtInt16 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vmovdqu32"
VecFormat Int
64 ScalarFormat
FmtInt8 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vmovdqu32"
Format
_ -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vmovdqu"
PXOR Format
format Operand
src Reg
dst
-> Line doc -> Format -> Operand -> Reg -> doc
pprPXor (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"pxor") Format
format Operand
src Reg
dst
VPXOR Format
format Reg
s1 Reg
s2 Reg
dst
-> Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprXor (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vpxor") Format
format Reg
s1 Reg
s2 Reg
dst
VEXTRACT Format
format Imm
offset Reg
from Operand
to
-> Line doc -> Format -> Imm -> Reg -> Operand -> doc
pprFormatImmRegOp (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vextract") Format
format Imm
offset Reg
from Operand
to
INSERTPS Format
format Imm
offset Operand
addr Reg
dst
-> Line doc -> Format -> Imm -> Operand -> Reg -> doc
pprInsert (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"insertps") Format
format Imm
offset Operand
addr Reg
dst
SHUF Format
format Imm
offset Operand
src Reg
dst
-> Line doc -> Format -> Imm -> Operand -> Reg -> doc
pprShuf (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"shuf" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
format) Format
format Imm
offset Operand
src Reg
dst
VSHUF Format
format Imm
offset Operand
src1 Reg
src2 Reg
dst
-> Line doc -> Format -> Imm -> Operand -> Reg -> Reg -> doc
pprVShuf (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vshuf" Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
format) Format
format Imm
offset Operand
src1 Reg
src2 Reg
dst
PSHUFD Format
format Imm
offset Operand
src Reg
dst
-> Line doc -> Format -> Imm -> Operand -> Reg -> doc
pprShuf (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"pshufd") Format
format Imm
offset Operand
src Reg
dst
VPSHUFD Format
format Imm
offset Operand
src Reg
dst
-> Line doc -> Format -> Imm -> Operand -> Reg -> doc
pprShuf (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vpshufd") Format
format Imm
offset Operand
src Reg
dst
PSLLDQ Format
format Operand
offset Reg
dst
-> Line doc -> Format -> Operand -> Reg -> doc
pprDoubleShift (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"pslldq") Format
format Operand
offset Reg
dst
PSRLDQ Format
format Operand
offset Reg
dst
-> Line doc -> Format -> Operand -> Reg -> doc
pprDoubleShift (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"psrldq") Format
format Operand
offset Reg
dst
MOVHLPS Format
format Reg
from Reg
to
-> Line doc -> Format -> Operand -> Reg -> doc
pprOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"movhlps") Format
format (Reg -> Operand
OpReg Reg
from) Reg
to
PUNPCKLQDQ Format
format Operand
from Reg
to
-> Line doc -> Format -> Operand -> Reg -> doc
pprOpReg (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"punpcklqdq") Format
format Operand
from Reg
to
MINMAX MinOrMax
minMax MinMaxType
ty Format
fmt Operand
src Operand
dst
-> Bool -> MinOrMax -> MinMaxType -> Format -> [Operand] -> doc
pprMinMax Bool
False MinOrMax
minMax MinMaxType
ty Format
fmt [Operand
src, Operand
dst]
VMINMAX MinOrMax
minMax MinMaxType
ty Format
fmt Operand
src1 Reg
src2 Reg
dst
-> Bool -> MinOrMax -> MinMaxType -> Format -> [Operand] -> doc
pprMinMax Bool
True MinOrMax
minMax MinMaxType
ty Format
fmt [Operand
src1, Reg -> Operand
OpReg Reg
src2, Reg -> Operand
OpReg Reg
dst]
where
gtab :: Line doc
gtab :: Line doc
gtab = Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t'
gsp :: Line doc
gsp :: Line doc
gsp = Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
' '
pprX87 :: Instr -> Line doc -> doc
pprX87 :: Instr -> Line doc -> doc
pprX87 Instr
fake Line doc
actual
= 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
<> Instr -> Line doc
pprX87Instr Instr
fake) doc -> doc -> doc
forall doc. IsDoc doc => doc -> doc -> doc
$$ Line doc -> doc
forall doc. IsDoc doc => Line doc -> doc
line Line doc
actual
pprX87Instr :: Instr -> Line doc
pprX87Instr :: Instr -> Line doc
pprX87Instr (X87Store Format
fmt AddrMode
dst) = Line doc -> Format -> AddrMode -> Line doc
pprFormatAddr (String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"gst") Format
fmt AddrMode
dst
pprX87Instr Instr
_ = String -> Line doc
forall a. HasCallStack => String -> a
panic String
"X86.Ppr.pprX87Instr: no match"
pprDollImm :: Imm -> Line doc
pprDollImm :: Imm -> Line doc
pprDollImm Imm
i = 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 -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
i
pprOperand :: Platform -> Format -> Operand -> Line doc
pprOperand :: Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
f Operand
op = case Operand
op of
OpReg Reg
r -> Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
f Reg
r
OpImm Imm
i -> Imm -> Line doc
pprDollImm Imm
i
OpAddr AddrMode
ea -> Platform -> AddrMode -> Line doc
forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform AddrMode
ea
pprMnemonic_ :: Line doc -> Line doc
pprMnemonic_ :: Line doc -> Line doc
pprMnemonic_ Line doc
name =
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
name Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
space
pprMnemonic :: Line doc -> Format -> Line doc
pprMnemonic :: Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format =
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
name Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
format Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
space
pprGenMnemonic :: Line doc -> Format -> Line doc
pprGenMnemonic :: Line doc -> Format -> Line doc
pprGenMnemonic Line doc
name Format
_ =
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
name 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
forall doc. IsLine doc => doc
space
pprBroadcastMnemonic :: Line doc -> Format -> Line doc
pprBroadcastMnemonic :: Line doc -> Format -> Line doc
pprBroadcastMnemonic Line doc
name Format
format =
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'\t' Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
name Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Format -> Line doc
pprBroadcastFormat Format
format Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
space
pprBroadcastFormat :: Format -> Line doc
pprBroadcastFormat :: Format -> Line doc
pprBroadcastFormat (VecFormat Int
_ ScalarFormat
f)
= case ScalarFormat
f of
ScalarFormat
FmtFloat -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"ss"
ScalarFormat
FmtDouble -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"sd"
ScalarFormat
FmtInt8 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"b"
ScalarFormat
FmtInt16 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"w"
ScalarFormat
FmtInt32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"d"
ScalarFormat
FmtInt64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"q"
pprBroadcastFormat Format
_ = String -> Line doc
forall a. HasCallStack => String -> a
panic String
"Scalar Format invading vector operation"
pprFormatImmOp :: Line doc -> Format -> Imm -> Operand -> doc
pprFormatImmOp :: Line doc -> Format -> Imm -> Operand -> doc
pprFormatImmOp Line doc
name Format
format Imm
imm Operand
op1
= 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Char -> Line doc
forall doc. IsLine doc => Char -> doc
char Char
'$',
Platform -> Imm -> Line doc
forall doc. IsLine doc => Platform -> Imm -> doc
pprImm Platform
platform Imm
imm,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1
]
pprFormatOp_ :: Line doc -> Format -> Operand -> doc
pprFormatOp_ :: Line doc -> Format -> Operand -> doc
pprFormatOp_ Line doc
name Format
format Operand
op1
= 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 [
Line doc -> Line doc
pprMnemonic_ Line doc
name ,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1
]
pprFormatOp :: Line doc -> Format -> Operand -> doc
pprFormatOp :: Line doc -> Format -> Operand -> doc
pprFormatOp Line doc
name Format
format Operand
op1
= 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1
]
pprFormatOpOp :: Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp :: Line doc -> Format -> Operand -> Operand -> doc
pprFormatOpOp Line doc
name Format
format Operand
op1 Operand
op2
= 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op2
]
pprMovdOpOp :: Line doc -> Format -> Operand -> Operand -> doc
pprMovdOpOp :: Line doc -> Format -> Operand -> Operand -> doc
pprMovdOpOp Line doc
name Format
format Operand
op1 Operand
op2
= let instr :: Line doc
instr = case Format
format of
Format
II32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"d"
Format
II64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"q"
Format
FF32 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"d"
Format
FF64 -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"q"
Format
_ -> String -> Line doc
forall a. HasCallStack => String -> a
panic String
"X86.Ppr.pprMovdOpOp: improper format for movd/movq."
in 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 -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
name Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
instr Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
space,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform (Format -> Format
movdOutFormat Format
format) Operand
op2
]
pprFormatImmRegOp :: Line doc -> Format -> Imm -> Reg -> Operand -> doc
pprFormatImmRegOp :: Line doc -> Format -> Imm -> Reg -> Operand -> doc
pprFormatImmRegOp Line doc
name Format
format Imm
off Reg
reg1 Operand
op2
= 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Imm -> Line doc
pprDollImm Imm
off,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op2
]
pprFormatOpRegReg :: Line doc -> Format -> Operand -> Reg -> Reg -> doc
pprFormatOpRegReg :: Line doc -> Format -> Operand -> Reg -> Reg -> doc
pprFormatOpRegReg Line doc
name Format
format Operand
op1 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg2,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg3
]
pprFMAPermutation :: FMAPermutation -> Line doc
pprFMAPermutation :: FMAPermutation -> Line doc
pprFMAPermutation FMAPermutation
FMA132 = String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"132"
pprFMAPermutation FMAPermutation
FMA213 = String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"213"
pprFMAPermutation FMAPermutation
FMA231 = String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"231"
pprOpOp :: Line doc -> Format -> Operand -> Operand -> doc
pprOpOp :: Line doc -> Format -> Operand -> Operand -> doc
pprOpOp Line doc
name Format
format Operand
op1 Operand
op2
= 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 [
Line doc -> Line doc
pprMnemonic_ Line doc
name,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op2
]
pprRegReg :: Line doc -> Reg -> Reg -> doc
pprRegReg :: Line doc -> Reg -> Reg -> doc
pprRegReg Line doc
name 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 [
Line doc -> Line doc
pprMnemonic_ Line doc
name,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg2
]
pprOpReg :: Line doc -> Format -> Operand -> Reg -> doc
pprOpReg :: Line doc -> Format -> Operand -> Reg -> doc
pprOpReg Line doc
name Format
format Operand
op 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 [
Line doc -> Line doc
pprMnemonic_ Line doc
name,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg
]
pprFormatOpReg :: Line doc -> Format -> Operand -> Reg -> doc
pprFormatOpReg :: Line doc -> Format -> Operand -> Reg -> doc
pprFormatOpReg Line doc
name Format
format Operand
op1 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg2
]
pprCondOpReg :: Line doc -> Format -> Cond -> Operand -> Reg -> doc
pprCondOpReg :: Line doc -> Format -> Cond -> Operand -> Reg -> doc
pprCondOpReg Line doc
name Format
format Cond
cond Operand
op1 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
name,
Cond -> Line doc
forall doc. IsLine doc => Cond -> doc
pprCond Cond
cond,
Line doc
forall doc. IsLine doc => doc
space,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg2
]
pprFormatFormatOpReg :: Line doc -> Format -> Format -> Operand -> Reg -> doc
pprFormatFormatOpReg :: Line doc -> Format -> Format -> Operand -> Reg -> doc
pprFormatFormatOpReg Line doc
name Format
format1 Format
format2 Operand
op1 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format2,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format1 Operand
op1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format2 Reg
reg2
]
pprFormatOpOpReg :: Line doc -> Format -> Operand -> Operand -> Reg -> doc
pprFormatOpOpReg :: Line doc -> Format -> Operand -> Operand -> Reg -> doc
pprFormatOpOpReg Line doc
name Format
format Operand
op1 Operand
op2 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op2,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg3
]
pprFormatAddr :: Line doc -> Format -> AddrMode -> Line doc
pprFormatAddr :: Line doc -> Format -> AddrMode -> Line doc
pprFormatAddr Line doc
name Format
format AddrMode
op
= [Line doc] -> Line doc
forall doc. IsLine doc => [doc] -> doc
hcat [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> AddrMode -> Line doc
forall doc. IsLine doc => Platform -> AddrMode -> doc
pprAddr Platform
platform AddrMode
op
]
pprShift :: Line doc -> Format -> Operand -> Operand -> doc
pprShift :: Line doc -> Format -> Operand -> Operand -> doc
pprShift Line doc
name Format
format Operand
src Operand
dest
= 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
II8 Operand
src,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
dest
]
pprShift2 :: Line doc -> Format -> Operand -> Operand -> Operand -> doc
pprShift2 :: Line doc -> Format -> Operand -> Operand -> Operand -> doc
pprShift2 Line doc
name Format
format Operand
src Operand
dest1 Operand
dest2
= 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 [
Line doc -> Format -> Line doc
pprMnemonic Line doc
name Format
format,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
II8 Operand
src,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
dest1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
dest2
]
pprFormatOpOpCoerce :: Line doc -> Format -> Format -> Operand -> Operand -> doc
pprFormatOpOpCoerce :: Line doc -> Format -> Format -> Operand -> Operand -> doc
pprFormatOpOpCoerce Line doc
name Format
format1 Format
format2 Operand
op1 Operand
op2
= 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
name, Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
format1, Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
format2, Line doc
forall doc. IsLine doc => doc
space,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format1 Operand
op1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format2 Operand
op2
]
pprCondInstr :: Line doc -> Cond -> Line doc -> doc
pprCondInstr :: Line doc -> Cond -> Line doc -> doc
pprCondInstr Line doc
name Cond
cond Line doc
arg
= 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
name, Cond -> Line doc
forall doc. IsLine doc => Cond -> doc
pprCond Cond
cond, Line doc
forall doc. IsLine doc => doc
space, Line doc
arg]
pprBroadcast :: Line doc -> Format -> Operand -> Reg -> doc
pprBroadcast :: Line doc -> Format -> Operand -> Reg -> doc
pprBroadcast Line doc
name fmt :: Format
fmt@(VecFormat Int
_ ScalarFormat
sFmt) Operand
op Reg
dst
= 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 [
Line doc -> Format -> Line doc
pprBroadcastMnemonic Line doc
name Format
fmt,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform (ScalarFormat -> Format
scalarFormatFormat ScalarFormat
sFmt) Operand
op,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
fmt Reg
dst
]
pprBroadcast Line doc
_ Format
fmt Operand
_ Reg
_ =
String -> SDoc -> doc
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"pprBroadcast: expected vector format" (Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
fmt)
pprXor :: Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprXor :: Line doc -> Format -> Reg -> Reg -> Reg -> doc
pprXor Line doc
name Format
format 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 [
Line doc -> Format -> Line doc
pprGenMnemonic Line doc
name Format
format,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg2,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg3
]
pprPXor :: Line doc -> Format -> Operand -> Reg -> doc
pprPXor :: Line doc -> Format -> Operand -> Reg -> doc
pprPXor Line doc
name Format
format Operand
src Reg
dst
= 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 [
Line doc -> Format -> Line doc
pprGenMnemonic Line doc
name Format
format,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
src,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
dst
]
pprVxor :: Format -> Operand -> Reg -> Reg -> doc
pprVxor :: Format -> Operand -> Reg -> Reg -> doc
pprVxor Format
fmt Operand
src1 Reg
src2 Reg
dst
= 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 [
Line doc -> Format -> Line doc
pprGenMnemonic Line doc
mem Format
fmt,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
fmt Operand
src1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
fmt Reg
src2,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
fmt Reg
dst
]
where
mem :: Line doc
mem = case Format
fmt of
VecFormat Int
_ ScalarFormat
FmtFloat -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vxorps"
VecFormat Int
_ ScalarFormat
FmtDouble -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"vxorpd"
Format
_ -> String -> SDoc -> Line doc
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"GHC.CmmToAsm.X86.Ppr.pprVxor: elementy type must be Float or Double"
(Format -> SDoc
forall a. Outputable a => a -> SDoc
ppr Format
fmt)
pprInsert :: Line doc -> Format -> Imm -> Operand -> Reg -> doc
pprInsert :: Line doc -> Format -> Imm -> Operand -> Reg -> doc
pprInsert Line doc
name Format
format Imm
off Operand
src Reg
dst
= 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 [
Line doc -> Format -> Line doc
pprGenMnemonic Line doc
name Format
format,
Imm -> Line doc
pprDollImm Imm
off,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
src,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
dst
]
pprShuf :: Line doc -> Format -> Imm -> Operand -> Reg -> doc
pprShuf :: Line doc -> Format -> Imm -> Operand -> Reg -> doc
pprShuf Line doc
name Format
format Imm
imm1 Operand
op2 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 [
Line doc -> Format -> Line doc
pprGenMnemonic Line doc
name Format
format,
Imm -> Line doc
pprDollImm Imm
imm1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op2,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg3
]
pprVShuf :: Line doc -> Format -> Imm -> Operand -> Reg -> Reg -> doc
pprVShuf :: Line doc -> Format -> Imm -> Operand -> Reg -> Reg -> doc
pprVShuf Line doc
name Format
format Imm
imm1 Operand
op2 Reg
reg3 Reg
reg4
= 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 [
Line doc -> Format -> Line doc
pprGenMnemonic Line doc
name Format
format,
Imm -> Line doc
pprDollImm Imm
imm1,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
op2,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg3,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg4
]
pprDoubleShift :: Line doc -> Format -> Operand -> Reg -> doc
pprDoubleShift :: Line doc -> Format -> Operand -> Reg -> doc
pprDoubleShift Line doc
name Format
format Operand
off 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 [
Line doc -> Format -> Line doc
pprGenMnemonic Line doc
name Format
format,
Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
format Operand
off,
Line doc
forall doc. IsLine doc => doc
comma,
Platform -> Format -> Reg -> Line doc
forall doc. IsLine doc => Platform -> Format -> Reg -> doc
pprReg Platform
platform Format
format Reg
reg
]
pprMinMax :: Bool -> MinOrMax -> MinMaxType -> Format -> [Operand] -> doc
pprMinMax :: Bool -> MinOrMax -> MinMaxType -> Format -> [Operand] -> doc
pprMinMax Bool
wantV MinOrMax
minOrMax MinMaxType
mmTy Format
fmt [Operand]
regs
= 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 ( Line doc
instr Line doc -> [Line doc] -> [Line doc]
forall a. a -> [a] -> [a]
: Line doc -> [Line doc] -> [Line doc]
forall a. a -> [a] -> [a]
intersperse Line doc
forall doc. IsLine doc => doc
comma ( (Operand -> Line doc) -> [Operand] -> [Line doc]
forall a b. (a -> b) -> [a] -> [b]
map ( Platform -> Format -> Operand -> Line doc
pprOperand Platform
platform Format
fmt ) [Operand]
regs ) )
where
instr :: Line doc
instr = (if Bool
wantV then String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"v" else Line doc
forall doc. IsOutput doc => doc
empty)
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> (case MinMaxType
mmTy of { IntVecMinMax {} -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"p"; MinMaxType
FloatMinMax -> Line doc
forall doc. IsOutput doc => doc
empty })
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> (case MinOrMax
minOrMax of { MinOrMax
Min -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"min"; MinOrMax
Max -> String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"max" })
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> (case MinMaxType
mmTy of { IntVecMinMax Bool
wantSigned -> if Bool
wantSigned then String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"s" else String -> Line doc
forall doc. IsLine doc => String -> doc
text String
"u"; MinMaxType
FloatMinMax -> Line doc
forall doc. IsOutput doc => doc
empty })
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Format -> Line doc
forall doc. IsLine doc => Format -> doc
pprFormat Format
fmt
Line doc -> Line doc -> Line doc
forall doc. IsLine doc => doc -> doc -> doc
<> Line doc
forall doc. IsLine doc => doc
space