{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module X86.Ppr (
pprNatCmmDecl,
pprData,
pprInstr,
pprFormat,
pprImm,
pprDataItem,
)
where
#include "GhclibHsVersions.h"
#include "nativeGen/NCG.h"
import GhcPrelude
import X86.Regs
import X86.Instr
import X86.Cond
import Instruction
import Format
import Reg
import PprBase
import Hoopl.Collections
import Hoopl.Label
import BasicTypes (Alignment)
import DynFlags
import Cmm hiding (topInfoTable)
import BlockId
import CLabel
import Unique ( pprUniqueAlways )
import Platform
import FastString
import Outputable
import Data.Word
import Data.Bits
pprProcAlignment :: SDoc
pprProcAlignment :: SDoc
pprProcAlignment = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
(SDoc -> (Int -> SDoc) -> Maybe Int -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
empty Int -> SDoc
pprAlign (Maybe Int -> SDoc) -> (DynFlags -> Maybe Int) -> DynFlags -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DynFlags -> Maybe Int
cmmProcAlignment (DynFlags -> SDoc) -> DynFlags -> SDoc
forall a b. (a -> b) -> a -> b
$ DynFlags
dflags)
pprNatCmmDecl :: NatCmmDecl (Alignment, CmmStatics) Instr -> SDoc
pprNatCmmDecl :: NatCmmDecl (Int, CmmStatics) Instr -> SDoc
pprNatCmmDecl (CmmData Section
section (Int, CmmStatics)
dats) =
Section -> SDoc
pprSectionAlign Section
section SDoc -> SDoc -> SDoc
$$ (Int, CmmStatics) -> SDoc
pprDatas (Int, CmmStatics)
dats
pprNatCmmDecl proc :: NatCmmDecl (Int, CmmStatics) Instr
proc@(CmmProc LabelMap CmmStatics
top_info CLabel
lbl [GlobalReg]
_ (ListGraph [GenBasicBlock Instr]
blocks)) =
(DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
SDoc
pprProcAlignment SDoc -> SDoc -> SDoc
$$
case NatCmmDecl (Int, CmmStatics) Instr -> Maybe CmmStatics
forall a i b. GenCmmDecl a (LabelMap i) (ListGraph b) -> Maybe i
topInfoTable NatCmmDecl (Int, CmmStatics) Instr
proc of
Maybe CmmStatics
Nothing ->
case [GenBasicBlock Instr]
blocks of
[] ->
CLabel -> SDoc
pprLabel CLabel
lbl
[GenBasicBlock Instr]
blocks ->
Section -> SDoc
pprSectionAlign (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
lbl) SDoc -> SDoc -> SDoc
$$
SDoc
pprProcAlignment SDoc -> SDoc -> SDoc
$$
CLabel -> SDoc
pprLabel CLabel
lbl SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
vcat ((GenBasicBlock Instr -> SDoc) -> [GenBasicBlock Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (LabelMap CmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock LabelMap CmmStatics
top_info) [GenBasicBlock Instr]
blocks) SDoc -> SDoc -> SDoc
$$
(if DynFlags -> Int
debugLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkAsmTempEndLabel CLabel
lbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' else SDoc
empty) SDoc -> SDoc -> SDoc
$$
CLabel -> SDoc
pprSizeDecl CLabel
lbl
Just (Statics CLabel
info_lbl [CmmStatic]
_) ->
(Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
Section -> SDoc
pprSectionAlign (SectionType -> CLabel -> Section
Section SectionType
Text CLabel
info_lbl) SDoc -> SDoc -> SDoc
$$
SDoc
pprProcAlignment SDoc -> SDoc -> SDoc
$$
(if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
then CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':'
else SDoc
empty) SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
vcat ((GenBasicBlock Instr -> SDoc) -> [GenBasicBlock Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (LabelMap CmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock LabelMap CmmStatics
top_info) [GenBasicBlock Instr]
blocks) SDoc -> SDoc -> SDoc
$$
(if Platform -> Bool
platformHasSubsectionsViaSymbols Platform
platform
then
String -> SDoc
text String
"\t.long "
SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
info_lbl
SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char Char
'-'
SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkDeadStripPreventer CLabel
info_lbl)
else SDoc
empty) SDoc -> SDoc -> SDoc
$$
CLabel -> SDoc
pprSizeDecl CLabel
info_lbl
pprSizeDecl :: CLabel -> SDoc
pprSizeDecl :: CLabel -> SDoc
pprSizeDecl CLabel
lbl
= (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
if OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform)
then String -> SDoc
text String
"\t.size" SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
", .-") SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
else SDoc
empty
pprBasicBlock :: LabelMap CmmStatics -> NatBasicBlock Instr -> SDoc
pprBasicBlock :: LabelMap CmmStatics -> GenBasicBlock Instr -> SDoc
pprBasicBlock LabelMap CmmStatics
info_env (BasicBlock BlockId
blockid [Instr]
instrs)
= (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags ->
DynFlags -> SDoc -> SDoc
maybe_infotable DynFlags
dflags (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
CLabel -> SDoc
pprLabel CLabel
asmLbl SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
vcat ((Instr -> SDoc) -> [Instr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Instr -> SDoc
pprInstr [Instr]
instrs) SDoc -> SDoc -> SDoc
$$
(if DynFlags -> Int
debugLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkAsmTempEndLabel CLabel
asmLbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' else SDoc
empty)
where
asmLbl :: CLabel
asmLbl = BlockId -> CLabel
blockLbl BlockId
blockid
maybe_infotable :: DynFlags -> SDoc -> SDoc
maybe_infotable DynFlags
dflags SDoc
c = case KeyOf LabelMap -> LabelMap CmmStatics -> Maybe CmmStatics
forall (map :: * -> *) a.
IsMap map =>
KeyOf map -> map a -> Maybe a
mapLookup KeyOf LabelMap
BlockId
blockid LabelMap CmmStatics
info_env of
Maybe CmmStatics
Nothing -> SDoc
c
Just (Statics CLabel
infoLbl [CmmStatic]
info) ->
SectionType -> SDoc
pprAlignForSection SectionType
Text SDoc -> SDoc -> SDoc
$$
SDoc
infoTableLoc SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
vcat ((CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CmmStatic -> SDoc
pprData [CmmStatic]
info) SDoc -> SDoc -> SDoc
$$
CLabel -> SDoc
pprLabel CLabel
infoLbl SDoc -> SDoc -> SDoc
$$
SDoc
c SDoc -> SDoc -> SDoc
$$
(if DynFlags -> Int
debugLevel DynFlags
dflags Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr (CLabel -> CLabel
mkAsmTempEndLabel CLabel
infoLbl) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':' else SDoc
empty)
infoTableLoc :: SDoc
infoTableLoc = case [Instr]
instrs of
(l :: Instr
l@LOCATION{} : [Instr]
_) -> Instr -> SDoc
pprInstr Instr
l
[Instr]
_other -> SDoc
empty
pprDatas :: (Alignment, CmmStatics) -> SDoc
pprDatas :: (Int, CmmStatics) -> SDoc
pprDatas (Int
align, (Statics CLabel
lbl [CmmStatic]
dats))
= [SDoc] -> SDoc
vcat (Int -> SDoc
pprAlign Int
align SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: CLabel -> SDoc
pprLabel CLabel
lbl SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (CmmStatic -> SDoc) -> [CmmStatic] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map CmmStatic -> SDoc
pprData [CmmStatic]
dats)
pprData :: CmmStatic -> SDoc
pprData :: CmmStatic -> SDoc
pprData (CmmString [Word8]
str)
= PtrString -> SDoc
ptext (String -> PtrString
sLit String
"\t.asciz ") SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
doubleQuotes ([Word8] -> SDoc
pprASCII [Word8]
str)
pprData (CmmUninitialised Int
bytes)
= (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
if Platform -> OS
platformOS Platform
platform OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin then String -> SDoc
text String
".space " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
bytes
else String -> SDoc
text String
".skip " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
bytes
pprData (CmmStaticLit CmmLit
lit) = CmmLit -> SDoc
pprDataItem CmmLit
lit
pprGloblDecl :: CLabel -> SDoc
pprGloblDecl :: CLabel -> SDoc
pprGloblDecl CLabel
lbl
| Bool -> Bool
not (CLabel -> Bool
externallyVisibleCLabel CLabel
lbl) = SDoc
empty
| Bool
otherwise = String -> SDoc
text String
".globl " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl
pprLabelType' :: DynFlags -> CLabel -> SDoc
pprLabelType' :: DynFlags -> CLabel -> SDoc
pprLabelType' DynFlags
dflags CLabel
lbl =
if CLabel -> Bool
isCFunctionLabel CLabel
lbl Bool -> Bool -> Bool
|| Bool
functionOkInfoTable then
String -> SDoc
text String
"@function"
else
String -> SDoc
text String
"@object"
where
functionOkInfoTable :: Bool
functionOkInfoTable = DynFlags -> Bool
tablesNextToCode DynFlags
dflags Bool -> Bool -> Bool
&&
CLabel -> Bool
isInfoTableLabel CLabel
lbl Bool -> Bool -> Bool
&& Bool -> Bool
not (CLabel -> Bool
isConInfoTableLabel CLabel
lbl)
pprTypeDecl :: CLabel -> SDoc
pprTypeDecl :: CLabel -> SDoc
pprTypeDecl CLabel
lbl
= (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
if OS -> Bool
osElfTarget (Platform -> OS
platformOS Platform
platform) Bool -> Bool -> Bool
&& CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
then
(DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
df ->
String -> SDoc
text String
".type " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
", ") SDoc -> SDoc -> SDoc
<> DynFlags -> CLabel -> SDoc
pprLabelType' DynFlags
df CLabel
lbl
else SDoc
empty
pprLabel :: CLabel -> SDoc
pprLabel :: CLabel -> SDoc
pprLabel CLabel
lbl = CLabel -> SDoc
pprGloblDecl CLabel
lbl
SDoc -> SDoc -> SDoc
$$ CLabel -> SDoc
pprTypeDecl CLabel
lbl
SDoc -> SDoc -> SDoc
$$ (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':')
pprAlign :: Int -> SDoc
pprAlign :: Int -> SDoc
pprAlign Int
bytes
= (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
String -> SDoc
text String
".align " SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Platform -> Int
alignment Platform
platform)
where
alignment :: Platform -> Int
alignment 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)
instance Outputable Instr where
ppr :: Instr -> SDoc
ppr Instr
instr = Instr -> SDoc
pprInstr Instr
instr
pprReg :: Format -> Reg -> SDoc
pprReg :: Format -> Reg -> SDoc
pprReg Format
f Reg
r
= case Reg
r of
RegReal (RealRegSingle Int
i) ->
(Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
if Platform -> Bool
target32Bit Platform
platform then Format -> Int -> SDoc
ppr32_reg_no Format
f Int
i
else Format -> Int -> SDoc
ppr64_reg_no Format
f Int
i
RegReal (RealRegPair Int
_ Int
_) -> String -> SDoc
forall a. String -> a
panic String
"X86.Ppr: no reg pairs on this arch"
RegVirtual (VirtualRegI Unique
u) -> String -> SDoc
text String
"%vI_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
RegVirtual (VirtualRegHi Unique
u) -> String -> SDoc
text String
"%vHi_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
RegVirtual (VirtualRegF Unique
u) -> String -> SDoc
text String
"%vF_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
RegVirtual (VirtualRegD Unique
u) -> String -> SDoc
text String
"%vD_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
RegVirtual (VirtualRegSSE Unique
u) -> String -> SDoc
text String
"%vSSE_" SDoc -> SDoc -> SDoc
<> Unique -> SDoc
pprUniqueAlways Unique
u
where
ppr32_reg_no :: Format -> Int -> SDoc
ppr32_reg_no :: Format -> Int -> SDoc
ppr32_reg_no Format
II8 = Int -> SDoc
forall a. (Eq a, Num a, Show a) => a -> SDoc
ppr32_reg_byte
ppr32_reg_no Format
II16 = Int -> SDoc
forall a. (Eq a, Num a) => a -> SDoc
ppr32_reg_word
ppr32_reg_no Format
_ = Int -> SDoc
ppr32_reg_long
ppr32_reg_byte :: a -> SDoc
ppr32_reg_byte a
i = PtrString -> SDoc
ptext
(case a
i of {
a
0 -> String -> PtrString
sLit String
"%al"; a
1 -> String -> PtrString
sLit String
"%bl";
a
2 -> String -> PtrString
sLit String
"%cl"; a
3 -> String -> PtrString
sLit String
"%dl";
a
_ -> String -> PtrString
sLit (String -> PtrString) -> String -> PtrString
forall a b. (a -> b) -> a -> b
$ String
"very naughty I386 byte register: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
})
ppr32_reg_word :: a -> SDoc
ppr32_reg_word a
i = PtrString -> SDoc
ptext
(case a
i of {
a
0 -> String -> PtrString
sLit String
"%ax"; a
1 -> String -> PtrString
sLit String
"%bx";
a
2 -> String -> PtrString
sLit String
"%cx"; a
3 -> String -> PtrString
sLit String
"%dx";
a
4 -> String -> PtrString
sLit String
"%si"; a
5 -> String -> PtrString
sLit String
"%di";
a
6 -> String -> PtrString
sLit String
"%bp"; a
7 -> String -> PtrString
sLit String
"%sp";
a
_ -> String -> PtrString
sLit String
"very naughty I386 word register"
})
ppr32_reg_long :: Int -> SDoc
ppr32_reg_long Int
i = PtrString -> SDoc
ptext
(case Int
i of {
Int
0 -> String -> PtrString
sLit String
"%eax"; Int
1 -> String -> PtrString
sLit String
"%ebx";
Int
2 -> String -> PtrString
sLit String
"%ecx"; Int
3 -> String -> PtrString
sLit String
"%edx";
Int
4 -> String -> PtrString
sLit String
"%esi"; Int
5 -> String -> PtrString
sLit String
"%edi";
Int
6 -> String -> PtrString
sLit String
"%ebp"; Int
7 -> String -> PtrString
sLit String
"%esp";
Int
_ -> Int -> PtrString
ppr_reg_float Int
i
})
ppr64_reg_no :: Format -> Int -> SDoc
ppr64_reg_no :: Format -> Int -> SDoc
ppr64_reg_no Format
II8 = Int -> SDoc
forall a. (Eq a, Num a, Show a) => a -> SDoc
ppr64_reg_byte
ppr64_reg_no Format
II16 = Int -> SDoc
forall a. (Eq a, Num a) => a -> SDoc
ppr64_reg_word
ppr64_reg_no Format
II32 = Int -> SDoc
forall a. (Eq a, Num a) => a -> SDoc
ppr64_reg_long
ppr64_reg_no Format
_ = Int -> SDoc
ppr64_reg_quad
ppr64_reg_byte :: a -> SDoc
ppr64_reg_byte a
i = PtrString -> SDoc
ptext
(case a
i of {
a
0 -> String -> PtrString
sLit String
"%al"; a
1 -> String -> PtrString
sLit String
"%bl";
a
2 -> String -> PtrString
sLit String
"%cl"; a
3 -> String -> PtrString
sLit String
"%dl";
a
4 -> String -> PtrString
sLit String
"%sil"; a
5 -> String -> PtrString
sLit String
"%dil";
a
6 -> String -> PtrString
sLit String
"%bpl"; a
7 -> String -> PtrString
sLit String
"%spl";
a
8 -> String -> PtrString
sLit String
"%r8b"; a
9 -> String -> PtrString
sLit String
"%r9b";
a
10 -> String -> PtrString
sLit String
"%r10b"; a
11 -> String -> PtrString
sLit String
"%r11b";
a
12 -> String -> PtrString
sLit String
"%r12b"; a
13 -> String -> PtrString
sLit String
"%r13b";
a
14 -> String -> PtrString
sLit String
"%r14b"; a
15 -> String -> PtrString
sLit String
"%r15b";
a
_ -> String -> PtrString
sLit (String -> PtrString) -> String -> PtrString
forall a b. (a -> b) -> a -> b
$ String
"very naughty x86_64 byte register: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i
})
ppr64_reg_word :: a -> SDoc
ppr64_reg_word a
i = PtrString -> SDoc
ptext
(case a
i of {
a
0 -> String -> PtrString
sLit String
"%ax"; a
1 -> String -> PtrString
sLit String
"%bx";
a
2 -> String -> PtrString
sLit String
"%cx"; a
3 -> String -> PtrString
sLit String
"%dx";
a
4 -> String -> PtrString
sLit String
"%si"; a
5 -> String -> PtrString
sLit String
"%di";
a
6 -> String -> PtrString
sLit String
"%bp"; a
7 -> String -> PtrString
sLit String
"%sp";
a
8 -> String -> PtrString
sLit String
"%r8w"; a
9 -> String -> PtrString
sLit String
"%r9w";
a
10 -> String -> PtrString
sLit String
"%r10w"; a
11 -> String -> PtrString
sLit String
"%r11w";
a
12 -> String -> PtrString
sLit String
"%r12w"; a
13 -> String -> PtrString
sLit String
"%r13w";
a
14 -> String -> PtrString
sLit String
"%r14w"; a
15 -> String -> PtrString
sLit String
"%r15w";
a
_ -> String -> PtrString
sLit String
"very naughty x86_64 word register"
})
ppr64_reg_long :: a -> SDoc
ppr64_reg_long a
i = PtrString -> SDoc
ptext
(case a
i of {
a
0 -> String -> PtrString
sLit String
"%eax"; a
1 -> String -> PtrString
sLit String
"%ebx";
a
2 -> String -> PtrString
sLit String
"%ecx"; a
3 -> String -> PtrString
sLit String
"%edx";
a
4 -> String -> PtrString
sLit String
"%esi"; a
5 -> String -> PtrString
sLit String
"%edi";
a
6 -> String -> PtrString
sLit String
"%ebp"; a
7 -> String -> PtrString
sLit String
"%esp";
a
8 -> String -> PtrString
sLit String
"%r8d"; a
9 -> String -> PtrString
sLit String
"%r9d";
a
10 -> String -> PtrString
sLit String
"%r10d"; a
11 -> String -> PtrString
sLit String
"%r11d";
a
12 -> String -> PtrString
sLit String
"%r12d"; a
13 -> String -> PtrString
sLit String
"%r13d";
a
14 -> String -> PtrString
sLit String
"%r14d"; a
15 -> String -> PtrString
sLit String
"%r15d";
a
_ -> String -> PtrString
sLit String
"very naughty x86_64 register"
})
ppr64_reg_quad :: Int -> SDoc
ppr64_reg_quad Int
i = PtrString -> SDoc
ptext
(case Int
i of {
Int
0 -> String -> PtrString
sLit String
"%rax"; Int
1 -> String -> PtrString
sLit String
"%rbx";
Int
2 -> String -> PtrString
sLit String
"%rcx"; Int
3 -> String -> PtrString
sLit String
"%rdx";
Int
4 -> String -> PtrString
sLit String
"%rsi"; Int
5 -> String -> PtrString
sLit String
"%rdi";
Int
6 -> String -> PtrString
sLit String
"%rbp"; Int
7 -> String -> PtrString
sLit String
"%rsp";
Int
8 -> String -> PtrString
sLit String
"%r8"; Int
9 -> String -> PtrString
sLit String
"%r9";
Int
10 -> String -> PtrString
sLit String
"%r10"; Int
11 -> String -> PtrString
sLit String
"%r11";
Int
12 -> String -> PtrString
sLit String
"%r12"; Int
13 -> String -> PtrString
sLit String
"%r13";
Int
14 -> String -> PtrString
sLit String
"%r14"; Int
15 -> String -> PtrString
sLit String
"%r15";
Int
_ -> Int -> PtrString
ppr_reg_float Int
i
})
ppr_reg_float :: Int -> PtrString
ppr_reg_float :: Int -> PtrString
ppr_reg_float Int
i = case Int
i of
Int
16 -> String -> PtrString
sLit String
"%fake0"; Int
17 -> String -> PtrString
sLit String
"%fake1"
Int
18 -> String -> PtrString
sLit String
"%fake2"; Int
19 -> String -> PtrString
sLit String
"%fake3"
Int
20 -> String -> PtrString
sLit String
"%fake4"; Int
21 -> String -> PtrString
sLit String
"%fake5"
Int
24 -> String -> PtrString
sLit String
"%xmm0"; Int
25 -> String -> PtrString
sLit String
"%xmm1"
Int
26 -> String -> PtrString
sLit String
"%xmm2"; Int
27 -> String -> PtrString
sLit String
"%xmm3"
Int
28 -> String -> PtrString
sLit String
"%xmm4"; Int
29 -> String -> PtrString
sLit String
"%xmm5"
Int
30 -> String -> PtrString
sLit String
"%xmm6"; Int
31 -> String -> PtrString
sLit String
"%xmm7"
Int
32 -> String -> PtrString
sLit String
"%xmm8"; Int
33 -> String -> PtrString
sLit String
"%xmm9"
Int
34 -> String -> PtrString
sLit String
"%xmm10"; Int
35 -> String -> PtrString
sLit String
"%xmm11"
Int
36 -> String -> PtrString
sLit String
"%xmm12"; Int
37 -> String -> PtrString
sLit String
"%xmm13"
Int
38 -> String -> PtrString
sLit String
"%xmm14"; Int
39 -> String -> PtrString
sLit String
"%xmm15"
Int
_ -> String -> PtrString
sLit String
"very naughty x86 register"
pprFormat :: Format -> SDoc
pprFormat :: Format -> SDoc
pprFormat Format
x
= PtrString -> SDoc
ptext (case Format
x of
Format
II8 -> String -> PtrString
sLit String
"b"
Format
II16 -> String -> PtrString
sLit String
"w"
Format
II32 -> String -> PtrString
sLit String
"l"
Format
II64 -> String -> PtrString
sLit String
"q"
Format
FF32 -> String -> PtrString
sLit String
"ss"
Format
FF64 -> String -> PtrString
sLit String
"sd"
Format
FF80 -> String -> PtrString
sLit String
"t"
)
pprFormat_x87 :: Format -> SDoc
pprFormat_x87 :: Format -> SDoc
pprFormat_x87 Format
x
= PtrString -> SDoc
ptext (PtrString -> SDoc) -> PtrString -> SDoc
forall a b. (a -> b) -> a -> b
$ case Format
x of
Format
FF32 -> String -> PtrString
sLit String
"s"
Format
FF64 -> String -> PtrString
sLit String
"l"
Format
FF80 -> String -> PtrString
sLit String
"t"
Format
_ -> String -> PtrString
forall a. String -> a
panic String
"X86.Ppr.pprFormat_x87"
pprCond :: Cond -> SDoc
pprCond :: Cond -> SDoc
pprCond Cond
c
= PtrString -> SDoc
ptext (case Cond
c of {
Cond
GEU -> String -> PtrString
sLit String
"ae"; Cond
LU -> String -> PtrString
sLit String
"b";
Cond
EQQ -> String -> PtrString
sLit String
"e"; Cond
GTT -> String -> PtrString
sLit String
"g";
Cond
GE -> String -> PtrString
sLit String
"ge"; Cond
GU -> String -> PtrString
sLit String
"a";
Cond
LTT -> String -> PtrString
sLit String
"l"; Cond
LE -> String -> PtrString
sLit String
"le";
Cond
LEU -> String -> PtrString
sLit String
"be"; Cond
NE -> String -> PtrString
sLit String
"ne";
Cond
NEG -> String -> PtrString
sLit String
"s"; Cond
POS -> String -> PtrString
sLit String
"ns";
Cond
CARRY -> String -> PtrString
sLit String
"c"; Cond
OFLO -> String -> PtrString
sLit String
"o";
Cond
PARITY -> String -> PtrString
sLit String
"p"; Cond
NOTPARITY -> String -> PtrString
sLit String
"np";
Cond
ALWAYS -> String -> PtrString
sLit String
"mp"})
pprImm :: Imm -> SDoc
pprImm :: Imm -> SDoc
pprImm (ImmInt Int
i) = Int -> SDoc
int Int
i
pprImm (ImmInteger Integer
i) = Integer -> SDoc
integer Integer
i
pprImm (ImmCLbl CLabel
l) = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l
pprImm (ImmIndex CLabel
l Int
i) = CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i
pprImm (ImmLit SDoc
s) = SDoc
s
pprImm (ImmFloat Rational
_) = String -> SDoc
text String
"naughty float immediate"
pprImm (ImmDouble Rational
_) = String -> SDoc
text String
"naughty double immediate"
pprImm (ImmConstantSum Imm
a Imm
b) = Imm -> SDoc
pprImm Imm
a SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
b
pprImm (ImmConstantDiff Imm
a Imm
b) = Imm -> SDoc
pprImm Imm
a SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'-'
SDoc -> SDoc -> SDoc
<> SDoc
lparen SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
b SDoc -> SDoc -> SDoc
<> SDoc
rparen
pprAddr :: AddrMode -> SDoc
pprAddr :: AddrMode -> SDoc
pprAddr (ImmAddr Imm
imm Int
off)
= let pp_imm :: SDoc
pp_imm = Imm -> SDoc
pprImm Imm
imm
in
if (Int
off Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) then
SDoc
pp_imm
else if (Int
off Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0) then
SDoc
pp_imm SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
off
else
SDoc
pp_imm SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'+' SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
off
pprAddr (AddrBaseIndex EABase
base EAIndex
index Imm
displacement)
= (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
let
pp_disp :: SDoc
pp_disp = Imm -> SDoc
ppr_disp Imm
displacement
pp_off :: SDoc -> SDoc
pp_off SDoc
p = SDoc
pp_disp SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
'(' SDoc -> SDoc -> SDoc
<> SDoc
p SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
')'
pp_reg :: Reg -> SDoc
pp_reg Reg
r = Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
r
in
case (EABase
base, EAIndex
index) of
(EABase
EABaseNone, EAIndex
EAIndexNone) -> SDoc
pp_disp
(EABaseReg Reg
b, EAIndex
EAIndexNone) -> SDoc -> SDoc
pp_off (Reg -> SDoc
pp_reg Reg
b)
(EABase
EABaseRip, EAIndex
EAIndexNone) -> SDoc -> SDoc
pp_off (String -> SDoc
text String
"%rip")
(EABase
EABaseNone, EAIndex Reg
r Int
i) -> SDoc -> SDoc
pp_off (SDoc
comma SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pp_reg Reg
r SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i)
(EABaseReg Reg
b, EAIndex Reg
r Int
i) -> SDoc -> SDoc
pp_off (Reg -> SDoc
pp_reg Reg
b SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> Reg -> SDoc
pp_reg Reg
r
SDoc -> SDoc -> SDoc
<> SDoc
comma SDoc -> SDoc -> SDoc
<> Int -> SDoc
int Int
i)
(EABase, EAIndex)
_ -> String -> SDoc
forall a. String -> a
panic String
"X86.Ppr.pprAddr: no match"
where
ppr_disp :: Imm -> SDoc
ppr_disp (ImmInt Int
0) = SDoc
empty
ppr_disp Imm
imm = Imm -> SDoc
pprImm Imm
imm
pprSectionAlign :: Section -> SDoc
pprSectionAlign :: Section -> SDoc
pprSectionAlign (Section (OtherSection String
_) CLabel
_) =
String -> SDoc
forall a. String -> a
panic String
"X86.Ppr.pprSectionAlign: unknown section"
pprSectionAlign sec :: Section
sec@(Section SectionType
seg CLabel
_) =
(Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
Platform -> Section -> SDoc
pprSectionHeader Platform
platform Section
sec SDoc -> SDoc -> SDoc
$$
SectionType -> SDoc
pprAlignForSection SectionType
seg
pprAlignForSection :: SectionType -> SDoc
pprAlignForSection :: SectionType -> SDoc
pprAlignForSection SectionType
seg =
(Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
String -> SDoc
text String
".align " SDoc -> SDoc -> SDoc
<>
case Platform -> OS
platformOS Platform
platform of
OS
OSDarwin
| Platform -> Bool
target32Bit Platform
platform ->
case SectionType
seg of
SectionType
ReadOnlyData16 -> Int -> SDoc
int Int
4
SectionType
CString -> Int -> SDoc
int Int
1
SectionType
_ -> Int -> SDoc
int Int
2
| Bool
otherwise ->
case SectionType
seg of
SectionType
ReadOnlyData16 -> Int -> SDoc
int Int
4
SectionType
CString -> Int -> SDoc
int Int
1
SectionType
_ -> Int -> SDoc
int Int
3
OS
_
| Platform -> Bool
target32Bit Platform
platform ->
case SectionType
seg of
SectionType
Text -> String -> SDoc
text String
"4,0x90"
SectionType
ReadOnlyData16 -> Int -> SDoc
int Int
16
SectionType
CString -> Int -> SDoc
int Int
1
SectionType
_ -> Int -> SDoc
int Int
4
| Bool
otherwise ->
case SectionType
seg of
SectionType
ReadOnlyData16 -> Int -> SDoc
int Int
16
SectionType
CString -> Int -> SDoc
int Int
1
SectionType
_ -> Int -> SDoc
int Int
8
pprDataItem :: CmmLit -> SDoc
pprDataItem :: CmmLit -> SDoc
pprDataItem CmmLit
lit = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \DynFlags
dflags -> DynFlags -> CmmLit -> SDoc
pprDataItem' DynFlags
dflags CmmLit
lit
pprDataItem' :: DynFlags -> CmmLit -> SDoc
pprDataItem' :: DynFlags -> CmmLit -> SDoc
pprDataItem' DynFlags
dflags CmmLit
lit
= [SDoc] -> SDoc
vcat (Format -> CmmLit -> [SDoc]
ppr_item (CmmType -> Format
cmmTypeFormat (CmmType -> Format) -> CmmType -> Format
forall a b. (a -> b) -> a -> b
$ DynFlags -> CmmLit -> CmmType
cmmLitType DynFlags
dflags CmmLit
lit) CmmLit
lit)
where
platform :: Platform
platform = DynFlags -> Platform
targetPlatform DynFlags
dflags
imm :: Imm
imm = CmmLit -> Imm
litToImm CmmLit
lit
ppr_item :: Format -> CmmLit -> [SDoc]
ppr_item Format
II8 CmmLit
_ = [String -> SDoc
text String
"\t.byte\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]
ppr_item Format
II16 CmmLit
_ = [String -> SDoc
text String
"\t.word\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]
ppr_item Format
II32 CmmLit
_ = [String -> SDoc
text String
"\t.long\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]
ppr_item Format
FF32 (CmmFloat Rational
r Width
_)
= let bs :: [Int]
bs = Float -> [Int]
floatToBytes (Rational -> Float
forall a. Fractional a => Rational -> a
fromRational Rational
r)
in (Int -> SDoc) -> [Int] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
b -> String -> SDoc
text String
"\t.byte\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm (Int -> Imm
ImmInt Int
b)) [Int]
bs
ppr_item Format
FF64 (CmmFloat Rational
r Width
_)
= let bs :: [Int]
bs = Double -> [Int]
doubleToBytes (Rational -> Double
forall a. Fractional a => Rational -> a
fromRational Rational
r)
in (Int -> SDoc) -> [Int] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
b -> String -> SDoc
text String
"\t.byte\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm (Int -> Imm
ImmInt Int
b)) [Int]
bs
ppr_item Format
II64 CmmLit
_
= case Platform -> OS
platformOS Platform
platform of
OS
OSDarwin
| Platform -> Bool
target32Bit Platform
platform ->
case CmmLit
lit of
CmmInt Integer
x Width
_ ->
[String -> SDoc
text String
"\t.long\t"
SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
x :: Word32)),
String -> SDoc
text String
"\t.long\t"
SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral
(Integer -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer
x Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) :: Word32))]
CmmLit
_ -> String -> [SDoc]
forall a. String -> a
panic String
"X86.Ppr.ppr_item: no match for II64"
| Bool
otherwise ->
[String -> SDoc
text String
"\t.quad\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]
OS
_
| Platform -> Bool
target32Bit Platform
platform ->
[String -> SDoc
text String
"\t.quad\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]
| Bool
otherwise ->
case CmmLit
lit of
CmmLabelDiffOff CLabel
_ CLabel
_ Int
_ Width
_ ->
[String -> SDoc
text String
"\t.long\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm,
String -> SDoc
text String
"\t.long\t0"]
CmmLit
_ ->
[String -> SDoc
text String
"\t.quad\t" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm]
ppr_item Format
_ CmmLit
_
= String -> [SDoc]
forall a. String -> a
panic String
"X86.Ppr.ppr_item: no match"
asmComment :: SDoc -> SDoc
SDoc
c = SDoc -> SDoc
whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text String
"# " SDoc -> SDoc -> SDoc
<> SDoc
c
pprInstr :: Instr -> SDoc
pprInstr :: Instr -> SDoc
pprInstr (COMMENT FastString
s)
= SDoc -> SDoc
asmComment (FastString -> SDoc
ftext FastString
s)
pprInstr (LOCATION Int
file Int
line Int
col String
_name)
= String -> SDoc
text String
"\t.loc " SDoc -> SDoc -> SDoc
<> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
file SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
line SDoc -> SDoc -> SDoc
<+> Int -> SDoc
forall a. Outputable a => a -> SDoc
ppr Int
col
pprInstr (DELTA Int
d)
= SDoc -> SDoc
asmComment (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text (String
"\tdelta = " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
d)
pprInstr (NEWBLOCK BlockId
_)
= String -> SDoc
forall a. String -> a
panic String
"PprMach.pprInstr: NEWBLOCK"
pprInstr (UNWIND CLabel
lbl UnwindTable
d)
= SDoc -> SDoc
asmComment (String -> SDoc
text String
"\tunwind = " SDoc -> SDoc -> SDoc
<> UnwindTable -> SDoc
forall a. Outputable a => a -> SDoc
ppr UnwindTable
d)
SDoc -> SDoc -> SDoc
$$ CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lbl SDoc -> SDoc -> SDoc
<> SDoc
colon
pprInstr (LDATA Section
_ (Int, CmmStatics)
_)
= String -> SDoc
forall a. String -> a
panic String
"PprMach.pprInstr: LDATA"
pprInstr (MOV Format
format (OpImm (ImmInt Int
0)) dst :: Operand
dst@(OpReg Reg
_))
= Instr -> SDoc
pprInstr (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
pprInstr (MOV Format
format Operand
src Operand
dst)
= PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"mov") Format
format Operand
src Operand
dst
pprInstr (CMOV Cond
cc Format
format Operand
src Reg
dst)
= PtrString -> Format -> Cond -> Operand -> Reg -> SDoc
pprCondOpReg (String -> PtrString
sLit String
"cmov") Format
format Cond
cc Operand
src Reg
dst
pprInstr (MOVZxL Format
II32 Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"mov") Format
II32 Operand
src Operand
dst
pprInstr (MOVZxL Format
formats Operand
src Operand
dst)
= PtrString -> Format -> Format -> Operand -> Operand -> SDoc
pprFormatOpOpCoerce (String -> PtrString
sLit String
"movz") Format
formats Format
II32 Operand
src Operand
dst
pprInstr (MOVSxL Format
formats Operand
src Operand
dst)
= (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
PtrString -> Format -> Format -> Operand -> Operand -> SDoc
pprFormatOpOpCoerce (String -> PtrString
sLit String
"movs") Format
formats (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Operand
src Operand
dst
pprInstr (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
= PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"add") Format
format (Reg -> Operand
OpReg Reg
reg2) Operand
dst
pprInstr (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
= PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"add") Format
format (Reg -> Operand
OpReg Reg
reg1) Operand
dst
pprInstr (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
= Instr -> SDoc
pprInstr (Format -> Operand -> Operand -> Instr
ADD Format
format (Imm -> Operand
OpImm Imm
displ) Operand
dst)
pprInstr (LEA Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"lea") Format
format Operand
src Operand
dst
pprInstr (ADD Format
format (OpImm (ImmInt (-1))) Operand
dst)
= PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"dec") Format
format Operand
dst
pprInstr (ADD Format
format (OpImm (ImmInt Int
1)) Operand
dst)
= PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"inc") Format
format Operand
dst
pprInstr (ADD Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"add") Format
format Operand
src Operand
dst
pprInstr (ADC Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"adc") Format
format Operand
src Operand
dst
pprInstr (SUB Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"sub") Format
format Operand
src Operand
dst
pprInstr (SBB Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"sbb") Format
format Operand
src Operand
dst
pprInstr (IMUL Format
format Operand
op1 Operand
op2) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"imul") Format
format Operand
op1 Operand
op2
pprInstr (ADD_CC Format
format Operand
src Operand
dst)
= PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"add") Format
format Operand
src Operand
dst
pprInstr (SUB_CC Format
format Operand
src Operand
dst)
= PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"sub") Format
format Operand
src Operand
dst
pprInstr (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
= Instr -> SDoc
pprInstr (Format -> Operand -> Operand -> Instr
AND Format
II32 Operand
src Operand
dst)
pprInstr (AND Format
FF32 Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit String
"andps") Format
FF32 Operand
src Operand
dst
pprInstr (AND Format
FF64 Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit String
"andpd") Format
FF64 Operand
src Operand
dst
pprInstr (AND Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"and") Format
format Operand
src Operand
dst
pprInstr (OR Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"or") Format
format Operand
src Operand
dst
pprInstr (XOR Format
FF32 Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit String
"xorps") Format
FF32 Operand
src Operand
dst
pprInstr (XOR Format
FF64 Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit String
"xorpd") Format
FF64 Operand
src Operand
dst
pprInstr (XOR Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"xor") Format
format Operand
src Operand
dst
pprInstr (POPCNT Format
format Operand
src Reg
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit String
"popcnt") Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
pprInstr (BSF Format
format Operand
src Reg
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit String
"bsf") Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
pprInstr (BSR Format
format Operand
src Reg
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp (String -> PtrString
sLit String
"bsr") Format
format Operand
src (Reg -> Operand
OpReg Reg
dst)
pprInstr (PDEP Format
format Operand
src Operand
mask Reg
dst) = PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
pprFormatOpOpReg (String -> PtrString
sLit String
"pdep") Format
format Operand
src Operand
mask Reg
dst
pprInstr (PEXT Format
format Operand
src Operand
mask Reg
dst) = PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
pprFormatOpOpReg (String -> PtrString
sLit String
"pext") Format
format Operand
src Operand
mask Reg
dst
pprInstr (PREFETCH PrefetchVariant
NTA Format
format Operand
src ) = PtrString -> Format -> Operand -> SDoc
pprFormatOp_ (String -> PtrString
sLit String
"prefetchnta") Format
format Operand
src
pprInstr (PREFETCH PrefetchVariant
Lvl0 Format
format Operand
src) = PtrString -> Format -> Operand -> SDoc
pprFormatOp_ (String -> PtrString
sLit String
"prefetcht0") Format
format Operand
src
pprInstr (PREFETCH PrefetchVariant
Lvl1 Format
format Operand
src) = PtrString -> Format -> Operand -> SDoc
pprFormatOp_ (String -> PtrString
sLit String
"prefetcht1") Format
format Operand
src
pprInstr (PREFETCH PrefetchVariant
Lvl2 Format
format Operand
src) = PtrString -> Format -> Operand -> SDoc
pprFormatOp_ (String -> PtrString
sLit String
"prefetcht2") Format
format Operand
src
pprInstr (NOT Format
format Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"not") Format
format Operand
op
pprInstr (BSWAP Format
format Reg
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"bswap") Format
format (Reg -> Operand
OpReg Reg
op)
pprInstr (NEGI Format
format Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"neg") Format
format Operand
op
pprInstr (SHL Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprShift (String -> PtrString
sLit String
"shl") Format
format Operand
src Operand
dst
pprInstr (SAR Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprShift (String -> PtrString
sLit String
"sar") Format
format Operand
src Operand
dst
pprInstr (SHR Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprShift (String -> PtrString
sLit String
"shr") Format
format Operand
src Operand
dst
pprInstr (BT Format
format Imm
imm Operand
src) = PtrString -> Format -> Imm -> Operand -> SDoc
pprFormatImmOp (String -> PtrString
sLit String
"bt") Format
format Imm
imm Operand
src
pprInstr (CMP Format
format Operand
src Operand
dst)
| Format -> Bool
isFloatFormat Format
format = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"ucomi") Format
format Operand
src Operand
dst
| Bool
otherwise = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"cmp") Format
format Operand
src Operand
dst
pprInstr (TEST Format
format Operand
src Operand
dst) = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
let 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
in PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"test") Format
format' Operand
src Operand
dst
where
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
pprInstr (PUSH Format
format Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"push") Format
format Operand
op
pprInstr (POP Format
format Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"pop") Format
format Operand
op
pprInstr Instr
NOP = String -> SDoc
text String
"\tnop"
pprInstr (CLTD Format
II8) = String -> SDoc
text String
"\tcbtw"
pprInstr (CLTD Format
II16) = String -> SDoc
text String
"\tcwtd"
pprInstr (CLTD Format
II32) = String -> SDoc
text String
"\tcltd"
pprInstr (CLTD Format
II64) = String -> SDoc
text String
"\tcqto"
pprInstr (CLTD Format
x) = String -> SDoc
forall a. String -> a
panic (String -> SDoc) -> String -> SDoc
forall a b. (a -> b) -> a -> b
$ String
"pprInstr: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Format -> String
forall a. Show a => a -> String
show Format
x
pprInstr (SETCC Cond
cond Operand
op) = PtrString -> Cond -> SDoc -> SDoc
pprCondInstr (String -> PtrString
sLit String
"set") Cond
cond (Format -> Operand -> SDoc
pprOperand Format
II8 Operand
op)
pprInstr (JXX Cond
cond BlockId
blockid)
= PtrString -> Cond -> SDoc -> SDoc
pprCondInstr (String -> PtrString
sLit String
"j") Cond
cond (CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
lab)
where lab :: CLabel
lab = BlockId -> CLabel
blockLbl BlockId
blockid
pprInstr (JXX_GBL Cond
cond Imm
imm) = PtrString -> Cond -> SDoc -> SDoc
pprCondInstr (String -> PtrString
sLit String
"j") Cond
cond (Imm -> SDoc
pprImm Imm
imm)
pprInstr (JMP (OpImm Imm
imm) [Reg]
_) = String -> SDoc
text String
"\tjmp " SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm
pprInstr (JMP Operand
op [Reg]
_) = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
String -> SDoc
text String
"\tjmp *"
SDoc -> SDoc -> SDoc
<> Format -> Operand -> SDoc
pprOperand (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Operand
op
pprInstr (JMP_TBL Operand
op [Maybe JumpDest]
_ Section
_ CLabel
_) = Instr -> SDoc
pprInstr (Operand -> [Reg] -> Instr
JMP Operand
op [])
pprInstr (CALL (Left Imm
imm) [Reg]
_) = String -> SDoc
text String
"\tcall " SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
imm
pprInstr (CALL (Right Reg
reg) [Reg]
_) = (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
String -> SDoc
text String
"\tcall *"
SDoc -> SDoc -> SDoc
<> Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg
pprInstr (IDIV Format
fmt Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"idiv") Format
fmt Operand
op
pprInstr (DIV Format
fmt Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"div") Format
fmt Operand
op
pprInstr (IMUL2 Format
fmt Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"imul") Format
fmt Operand
op
pprInstr (MUL Format
format Operand
op1 Operand
op2) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"mul") Format
format Operand
op1 Operand
op2
pprInstr (MUL2 Format
format Operand
op) = PtrString -> Format -> Operand -> SDoc
pprFormatOp (String -> PtrString
sLit String
"mul") Format
format Operand
op
pprInstr (FDIV Format
format Operand
op1 Operand
op2) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"div") Format
format Operand
op1 Operand
op2
pprInstr (SQRT Format
format Operand
op1 Reg
op2) = PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg (String -> PtrString
sLit String
"sqrt") Format
format Operand
op1 Reg
op2
pprInstr (CVTSS2SD Reg
from Reg
to) = PtrString -> Reg -> Reg -> SDoc
pprRegReg (String -> PtrString
sLit String
"cvtss2sd") Reg
from Reg
to
pprInstr (CVTSD2SS Reg
from Reg
to) = PtrString -> Reg -> Reg -> SDoc
pprRegReg (String -> PtrString
sLit String
"cvtsd2ss") Reg
from Reg
to
pprInstr (CVTTSS2SIQ Format
fmt Operand
from Reg
to) = PtrString -> Format -> Format -> Operand -> Reg -> SDoc
pprFormatFormatOpReg (String -> PtrString
sLit String
"cvttss2si") Format
FF32 Format
fmt Operand
from Reg
to
pprInstr (CVTTSD2SIQ Format
fmt Operand
from Reg
to) = PtrString -> Format -> Format -> Operand -> Reg -> SDoc
pprFormatFormatOpReg (String -> PtrString
sLit String
"cvttsd2si") Format
FF64 Format
fmt Operand
from Reg
to
pprInstr (CVTSI2SS Format
fmt Operand
from Reg
to) = PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg (String -> PtrString
sLit String
"cvtsi2ss") Format
fmt Operand
from Reg
to
pprInstr (CVTSI2SD Format
fmt Operand
from Reg
to) = PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg (String -> PtrString
sLit String
"cvtsi2sd") Format
fmt Operand
from Reg
to
pprInstr (FETCHGOT Reg
reg)
= [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"\tcall 1f",
[SDoc] -> SDoc
hcat [ String -> SDoc
text String
"1:\tpopl\t", Format -> Reg -> SDoc
pprReg Format
II32 Reg
reg ],
[SDoc] -> SDoc
hcat [ String -> SDoc
text String
"\taddl\t$_GLOBAL_OFFSET_TABLE_+(.-1b), ",
Format -> Reg -> SDoc
pprReg Format
II32 Reg
reg ]
]
pprInstr (FETCHPC Reg
reg)
= [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"\tcall 1f",
[SDoc] -> SDoc
hcat [ String -> SDoc
text String
"1:\tpopl\t", Format -> Reg -> SDoc
pprReg Format
II32 Reg
reg ]
]
pprInstr g :: Instr
g@(GMOV Reg
src Reg
dst)
| Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
= SDoc
empty
| Bool
otherwise
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src Int
0, SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GLD Format
fmt AddrMode
addr Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fld", Format -> SDoc
pprFormat_x87 Format
fmt, SDoc
gsp,
AddrMode -> SDoc
pprAddr AddrMode
addr, SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GST Format
fmt Reg
src AddrMode
addr)
| Reg
src Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
fake0 Bool -> Bool -> Bool
&& Format
fmt Format -> Format -> Bool
forall a. Eq a => a -> a -> Bool
/= Format
FF80
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab,
String -> SDoc
text String
"fst", Format -> SDoc
pprFormat_x87 Format
fmt, SDoc
gsp, AddrMode -> SDoc
pprAddr AddrMode
addr])
| Bool
otherwise
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src Int
0, SDoc
gsemi,
String -> SDoc
text String
"fstp", Format -> SDoc
pprFormat_x87 Format
fmt, SDoc
gsp, AddrMode -> SDoc
pprAddr AddrMode
addr])
pprInstr g :: Instr
g@(GLDZ Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fldz ; ", Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GLD1 Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fld1 ; ", Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr (GFTOI Reg
src Reg
dst)
= Instr -> SDoc
pprInstr (Reg -> Reg -> Instr
GDTOI Reg
src Reg
dst)
pprInstr g :: Instr
g@(GDTOI Reg
src Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
vcat [
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"subl $8, %esp ; fnstcw 4(%esp)"],
[SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src Int
0],
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"movzwl 4(%esp), ", SDoc
reg,
String -> SDoc
text String
" ; orl $0xC00, ", SDoc
reg],
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"movl ", SDoc
reg, String -> SDoc
text String
", 0(%esp) ; fldcw 0(%esp)"],
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fistpl 0(%esp)"],
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fldcw 4(%esp) ; movl 0(%esp), ", SDoc
reg],
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"addl $8, %esp"]
])
where
reg :: SDoc
reg = Format -> Reg -> SDoc
pprReg Format
II32 Reg
dst
pprInstr (GITOF Reg
src Reg
dst)
= Instr -> SDoc
pprInstr (Reg -> Reg -> Instr
GITOD Reg
src Reg
dst)
pprInstr g :: Instr
g@(GITOD Reg
src Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"pushl ", Format -> Reg -> SDoc
pprReg Format
II32 Reg
src,
String -> SDoc
text String
" ; fildl (%esp) ; ",
Reg -> Int -> SDoc
gpop Reg
dst Int
1, String -> SDoc
text String
" ; addl $4,%esp"])
pprInstr g :: Instr
g@(GDTOF Reg
src Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
vcat [SDoc
gtab SDoc -> SDoc -> SDoc
<> Reg -> Int -> SDoc
gpush Reg
src Int
0,
SDoc
gtab SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"subl $4,%esp ; fstps (%esp) ; flds (%esp) ; addl $4,%esp ;",
SDoc
gtab SDoc -> SDoc -> SDoc
<> Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GCMP Cond
cond Reg
src1 Reg
src2)
| case Cond
cond of { Cond
NE -> Bool
True; Cond
_ -> Bool
False }
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
vcat [
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"pushl %eax ; ",Reg -> Int -> SDoc
gpush Reg
src1 Int
0],
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fcomp ", Reg -> Int -> SDoc
greg Reg
src2 Int
1,
String -> SDoc
text String
"; fstsw %ax ; sahf ; setpe %ah"],
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"setne %al ; ",
String -> SDoc
text String
"orb %ah,%al ; decb %al ; popl %eax"]
])
| Bool
otherwise
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
vcat [
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"pushl %eax ; ",Reg -> Int -> SDoc
gpush Reg
src1 Int
0],
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fcomp ", Reg -> Int -> SDoc
greg Reg
src2 Int
1,
String -> SDoc
text String
"; fstsw %ax ; sahf ; setpo %ah"],
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"set", Cond -> SDoc
pprCond (Cond -> Cond
fix_FP_cond Cond
cond), String -> SDoc
text String
" %al ; ",
String -> SDoc
text String
"andb %ah,%al ; decb %al ; popl %eax"]
])
where
fix_FP_cond :: Cond -> Cond
fix_FP_cond :: Cond -> Cond
fix_FP_cond Cond
GE = Cond
GEU
fix_FP_cond Cond
GTT = Cond
GU
fix_FP_cond Cond
LTT = Cond
LU
fix_FP_cond Cond
LE = Cond
LEU
fix_FP_cond Cond
EQQ = Cond
EQQ
fix_FP_cond Cond
NE = Cond
NE
fix_FP_cond Cond
_ = String -> Cond
forall a. String -> a
panic String
"X86.Ppr.fix_FP_cond: no match"
pprInstr g :: Instr
g@(GABS Format
_ Reg
src Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src Int
0, String -> SDoc
text String
" ; fabs ; ", Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GNEG Format
_ Reg
src Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src Int
0, String -> SDoc
text String
" ; fchs ; ", Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GSQRT Format
fmt Reg
src Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src Int
0, String -> SDoc
text String
" ; fsqrt"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Format -> SDoc
gcoerceto Format
fmt, Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GSIN Format
fmt CLabel
l1 CLabel
l2 Reg
src Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Format -> SDoc
pprTrigOp String
"fsin" Bool
False CLabel
l1 CLabel
l2 Reg
src Reg
dst Format
fmt)
pprInstr g :: Instr
g@(GCOS Format
fmt CLabel
l1 CLabel
l2 Reg
src Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Format -> SDoc
pprTrigOp String
"fcos" Bool
False CLabel
l1 CLabel
l2 Reg
src Reg
dst Format
fmt)
pprInstr g :: Instr
g@(GTAN Format
fmt CLabel
l1 CLabel
l2 Reg
src Reg
dst)
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Format -> SDoc
pprTrigOp String
"fptan" Bool
True CLabel
l1 CLabel
l2 Reg
src Reg
dst Format
fmt)
pprInstr g :: Instr
g@(GADD Format
_ Reg
src1 Reg
src2 Reg
dst)
| Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text String
"\t#GADD-xxxcase1" SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src2 Int
0,
String -> SDoc
text String
" ; faddp %st(0),", Reg -> Int -> SDoc
greg Reg
src1 Int
1])
| Reg
src2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text String
"\t#GADD-xxxcase2" SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 Int
0,
String -> SDoc
text String
" ; faddp %st(0),", Reg -> Int -> SDoc
greg Reg
src2 Int
1])
| Bool
otherwise
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 Int
0,
String -> SDoc
text String
" ; fadd ", Reg -> Int -> SDoc
greg Reg
src2 Int
1, String -> SDoc
text String
",%st(0)",
SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GMUL Format
_ Reg
src1 Reg
src2 Reg
dst)
| Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text String
"\t#GMUL-xxxcase1" SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src2 Int
0,
String -> SDoc
text String
" ; fmulp %st(0),", Reg -> Int -> SDoc
greg Reg
src1 Int
1])
| Reg
src2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text String
"\t#GMUL-xxxcase2" SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 Int
0,
String -> SDoc
text String
" ; fmulp %st(0),", Reg -> Int -> SDoc
greg Reg
src2 Int
1])
| Bool
otherwise
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 Int
0,
String -> SDoc
text String
" ; fmul ", Reg -> Int -> SDoc
greg Reg
src2 Int
1, String -> SDoc
text String
",%st(0)",
SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GSUB Format
_ Reg
src1 Reg
src2 Reg
dst)
| Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text String
"\t#GSUB-xxxcase1" SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src2 Int
0,
String -> SDoc
text String
" ; fsubrp %st(0),", Reg -> Int -> SDoc
greg Reg
src1 Int
1])
| Reg
src2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text String
"\t#GSUB-xxxcase2" SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 Int
0,
String -> SDoc
text String
" ; fsubp %st(0),", Reg -> Int -> SDoc
greg Reg
src2 Int
1])
| Bool
otherwise
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 Int
0,
String -> SDoc
text String
" ; fsub ", Reg -> Int -> SDoc
greg Reg
src2 Int
1, String -> SDoc
text String
",%st(0)",
SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr g :: Instr
g@(GDIV Format
_ Reg
src1 Reg
src2 Reg
dst)
| Reg
src1 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text String
"\t#GDIV-xxxcase1" SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src2 Int
0,
String -> SDoc
text String
" ; fdivrp %st(0),", Reg -> Int -> SDoc
greg Reg
src1 Int
1])
| Reg
src2 Reg -> Reg -> Bool
forall a. Eq a => a -> a -> Bool
== Reg
dst
= Instr -> SDoc -> SDoc
pprG Instr
g (String -> SDoc
text String
"\t#GDIV-xxxcase2" SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 Int
0,
String -> SDoc
text String
" ; fdivp %st(0),", Reg -> Int -> SDoc
greg Reg
src2 Int
1])
| Bool
otherwise
= Instr -> SDoc -> SDoc
pprG Instr
g ([SDoc] -> SDoc
hcat [SDoc
gtab, Reg -> Int -> SDoc
gpush Reg
src1 Int
0,
String -> SDoc
text String
" ; fdiv ", Reg -> Int -> SDoc
greg Reg
src2 Int
1, String -> SDoc
text String
",%st(0)",
SDoc
gsemi, Reg -> Int -> SDoc
gpop Reg
dst Int
1])
pprInstr Instr
GFREE
= [SDoc] -> SDoc
vcat [ String -> SDoc
text String
"\tffree %st(0) ;ffree %st(1) ;ffree %st(2) ;ffree %st(3)",
String -> SDoc
text String
"\tffree %st(4) ;ffree %st(5)"
]
pprInstr (LOCK Instr
i) = String -> SDoc
text String
"\tlock" SDoc -> SDoc -> SDoc
$$ Instr -> SDoc
pprInstr Instr
i
pprInstr Instr
MFENCE = String -> SDoc
text String
"\tmfence"
pprInstr (XADD Format
format Operand
src Operand
dst) = PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"xadd") Format
format Operand
src Operand
dst
pprInstr (CMPXCHG Format
format Operand
src Operand
dst)
= PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp (String -> PtrString
sLit String
"cmpxchg") Format
format Operand
src Operand
dst
pprTrigOp :: String -> Bool -> CLabel -> CLabel
-> Reg -> Reg -> Format -> SDoc
pprTrigOp :: String -> Bool -> CLabel -> CLabel -> Reg -> Reg -> Format -> SDoc
pprTrigOp String
op
Bool
isTan
CLabel
l1 CLabel
l2
Reg
src Reg
dst Format
fmt
=
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"pushl %eax;"] SDoc -> SDoc -> SDoc
$$
(if Bool
isTan then [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"ffree %st(6)"] else SDoc
empty) SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [Reg -> Int -> SDoc
gpush Reg
src Int
0, String -> SDoc
text (String
"; " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
op)] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fnstsw %ax"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"test $0x400,%eax"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"je " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l1] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"ffree %st(7); fldpi"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fadd %st(0),%st"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fxch %st(1)"] SDoc -> SDoc -> SDoc
$$
(CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l2 SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':') SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fprem1"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fnstsw %ax"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"test $0x400,%eax"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"jne " SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l2] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fstp %st(1)"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
op] SDoc -> SDoc -> SDoc
$$
(CLabel -> SDoc
forall a. Outputable a => a -> SDoc
ppr CLabel
l1 SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':') SDoc -> SDoc -> SDoc
$$
(if Bool
isTan then [SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"fstp %st(0)"] else SDoc
empty) SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, String -> SDoc
text String
"popl %eax;"] SDoc -> SDoc -> SDoc
$$
[SDoc] -> SDoc
hcat [SDoc
gtab, Format -> SDoc
gcoerceto Format
fmt, Reg -> Int -> SDoc
gpop Reg
dst Int
1]
gcoerceto :: Format -> SDoc
gcoerceto :: Format -> SDoc
gcoerceto Format
FF64 = SDoc
empty
gcoerceto Format
FF32 = SDoc
empty
gcoerceto Format
_ = String -> SDoc
forall a. String -> a
panic String
"X86.Ppr.gcoerceto: no match"
gpush :: Reg -> RegNo -> SDoc
gpush :: Reg -> Int -> SDoc
gpush Reg
reg Int
offset
= [SDoc] -> SDoc
hcat [String -> SDoc
text String
"fld ", Reg -> Int -> SDoc
greg Reg
reg Int
offset]
gpop :: Reg -> RegNo -> SDoc
gpop :: Reg -> Int -> SDoc
gpop Reg
reg Int
offset
= [SDoc] -> SDoc
hcat [String -> SDoc
text String
"fstp ", Reg -> Int -> SDoc
greg Reg
reg Int
offset]
greg :: Reg -> RegNo -> SDoc
greg :: Reg -> Int -> SDoc
greg Reg
reg Int
offset = String -> SDoc
text String
"%st(" SDoc -> SDoc -> SDoc
<> Int -> SDoc
int (Reg -> Int
gregno Reg
reg Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
firstfakeInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
offset) SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
')'
gsemi :: SDoc
gsemi :: SDoc
gsemi = String -> SDoc
text String
" ; "
gtab :: SDoc
gtab :: SDoc
gtab = Char -> SDoc
char Char
'\t'
gsp :: SDoc
gsp :: SDoc
gsp = Char -> SDoc
char Char
' '
gregno :: Reg -> RegNo
gregno :: Reg -> Int
gregno (RegReal (RealRegSingle Int
i)) = Int
i
gregno Reg
_ =
Int
999
pprG :: Instr -> SDoc -> SDoc
pprG :: Instr -> SDoc -> SDoc
pprG Instr
fake SDoc
actual
= (Char -> SDoc
char Char
'#' SDoc -> SDoc -> SDoc
<> Instr -> SDoc
pprGInstr Instr
fake) SDoc -> SDoc -> SDoc
$$ SDoc
actual
pprGInstr :: Instr -> SDoc
pprGInstr :: Instr -> SDoc
pprGInstr (GMOV Reg
src Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"gmov") Format
FF64 Reg
src Reg
dst
pprGInstr (GLD Format
fmt AddrMode
src Reg
dst) = PtrString -> Format -> AddrMode -> Reg -> SDoc
pprFormatAddrReg (String -> PtrString
sLit String
"gld") Format
fmt AddrMode
src Reg
dst
pprGInstr (GST Format
fmt Reg
src AddrMode
dst) = PtrString -> Format -> Reg -> AddrMode -> SDoc
pprFormatRegAddr (String -> PtrString
sLit String
"gst") Format
fmt Reg
src AddrMode
dst
pprGInstr (GLDZ Reg
dst) = PtrString -> Format -> Reg -> SDoc
pprFormatReg (String -> PtrString
sLit String
"gldz") Format
FF64 Reg
dst
pprGInstr (GLD1 Reg
dst) = PtrString -> Format -> Reg -> SDoc
pprFormatReg (String -> PtrString
sLit String
"gld1") Format
FF64 Reg
dst
pprGInstr (GFTOI Reg
src Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit String
"gftoi") Format
FF32 Format
II32 Reg
src Reg
dst
pprGInstr (GDTOI Reg
src Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit String
"gdtoi") Format
FF64 Format
II32 Reg
src Reg
dst
pprGInstr (GITOF Reg
src Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit String
"gitof") Format
II32 Format
FF32 Reg
src Reg
dst
pprGInstr (GITOD Reg
src Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit String
"gitod") Format
II32 Format
FF64 Reg
src Reg
dst
pprGInstr (GDTOF Reg
src Reg
dst) = PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg (String -> PtrString
sLit String
"gdtof") Format
FF64 Format
FF32 Reg
src Reg
dst
pprGInstr (GCMP Cond
co Reg
src Reg
dst) = PtrString -> Format -> Cond -> Reg -> Reg -> SDoc
pprCondRegReg (String -> PtrString
sLit String
"gcmp_") Format
FF64 Cond
co Reg
src Reg
dst
pprGInstr (GABS Format
fmt Reg
src Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"gabs") Format
fmt Reg
src Reg
dst
pprGInstr (GNEG Format
fmt Reg
src Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"gneg") Format
fmt Reg
src Reg
dst
pprGInstr (GSQRT Format
fmt Reg
src Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"gsqrt") Format
fmt Reg
src Reg
dst
pprGInstr (GSIN Format
fmt CLabel
_ CLabel
_ Reg
src Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"gsin") Format
fmt Reg
src Reg
dst
pprGInstr (GCOS Format
fmt CLabel
_ CLabel
_ Reg
src Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"gcos") Format
fmt Reg
src Reg
dst
pprGInstr (GTAN Format
fmt CLabel
_ CLabel
_ Reg
src Reg
dst) = PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg (String -> PtrString
sLit String
"gtan") Format
fmt Reg
src Reg
dst
pprGInstr (GADD Format
fmt Reg
src1 Reg
src2 Reg
dst) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit String
"gadd") Format
fmt Reg
src1 Reg
src2 Reg
dst
pprGInstr (GSUB Format
fmt Reg
src1 Reg
src2 Reg
dst) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit String
"gsub") Format
fmt Reg
src1 Reg
src2 Reg
dst
pprGInstr (GMUL Format
fmt Reg
src1 Reg
src2 Reg
dst) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit String
"gmul") Format
fmt Reg
src1 Reg
src2 Reg
dst
pprGInstr (GDIV Format
fmt Reg
src1 Reg
src2 Reg
dst) = PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg (String -> PtrString
sLit String
"gdiv") Format
fmt Reg
src1 Reg
src2 Reg
dst
pprGInstr Instr
_ = String -> SDoc
forall a. String -> a
panic String
"X86.Ppr.pprGInstr: no match"
pprDollImm :: Imm -> SDoc
pprDollImm :: Imm -> SDoc
pprDollImm Imm
i = String -> SDoc
text String
"$" SDoc -> SDoc -> SDoc
<> Imm -> SDoc
pprImm Imm
i
pprOperand :: Format -> Operand -> SDoc
pprOperand :: Format -> Operand -> SDoc
pprOperand Format
f (OpReg Reg
r) = Format -> Reg -> SDoc
pprReg Format
f Reg
r
pprOperand Format
_ (OpImm Imm
i) = Imm -> SDoc
pprDollImm Imm
i
pprOperand Format
_ (OpAddr AddrMode
ea) = AddrMode -> SDoc
pprAddr AddrMode
ea
pprMnemonic_ :: PtrString -> SDoc
pprMnemonic_ :: PtrString -> SDoc
pprMnemonic_ PtrString
name =
Char -> SDoc
char Char
'\t' SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext PtrString
name SDoc -> SDoc -> SDoc
<> SDoc
space
pprMnemonic :: PtrString -> Format -> SDoc
pprMnemonic :: PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format =
Char -> SDoc
char Char
'\t' SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext PtrString
name SDoc -> SDoc -> SDoc
<> Format -> SDoc
pprFormat Format
format SDoc -> SDoc -> SDoc
<> SDoc
space
pprFormatImmOp :: PtrString -> Format -> Imm -> Operand -> SDoc
pprFormatImmOp :: PtrString -> Format -> Imm -> Operand -> SDoc
pprFormatImmOp PtrString
name Format
format Imm
imm Operand
op1
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Char -> SDoc
char Char
'$',
Imm -> SDoc
pprImm Imm
imm,
SDoc
comma,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op1
]
pprFormatOp_ :: PtrString -> Format -> Operand -> SDoc
pprFormatOp_ :: PtrString -> Format -> Operand -> SDoc
pprFormatOp_ PtrString
name Format
format Operand
op1
= [SDoc] -> SDoc
hcat [
PtrString -> SDoc
pprMnemonic_ PtrString
name ,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op1
]
pprFormatOp :: PtrString -> Format -> Operand -> SDoc
pprFormatOp :: PtrString -> Format -> Operand -> SDoc
pprFormatOp PtrString
name Format
format Operand
op1
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op1
]
pprFormatOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
pprFormatOpOp PtrString
name Format
format Operand
op1 Operand
op2
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
SDoc
comma,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op2
]
pprOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp :: PtrString -> Format -> Operand -> Operand -> SDoc
pprOpOp PtrString
name Format
format Operand
op1 Operand
op2
= [SDoc] -> SDoc
hcat [
PtrString -> SDoc
pprMnemonic_ PtrString
name,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
SDoc
comma,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op2
]
pprFormatReg :: PtrString -> Format -> Reg -> SDoc
pprFormatReg :: PtrString -> Format -> Reg -> SDoc
pprFormatReg PtrString
name Format
format Reg
reg1
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg1
]
pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg :: PtrString -> Format -> Reg -> Reg -> SDoc
pprFormatRegReg PtrString
name Format
format Reg
reg1 Reg
reg2
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg1,
SDoc
comma,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg2
]
pprRegReg :: PtrString -> Reg -> Reg -> SDoc
pprRegReg :: PtrString -> Reg -> Reg -> SDoc
pprRegReg PtrString
name Reg
reg1 Reg
reg2
= (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
[SDoc] -> SDoc
hcat [
PtrString -> SDoc
pprMnemonic_ PtrString
name,
Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg1,
SDoc
comma,
Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg2
]
pprFormatOpReg :: PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg :: PtrString -> Format -> Operand -> Reg -> SDoc
pprFormatOpReg PtrString
name Format
format Operand
op1 Reg
reg2
= (Platform -> SDoc) -> SDoc
sdocWithPlatform ((Platform -> SDoc) -> SDoc) -> (Platform -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \Platform
platform ->
[SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
SDoc
comma,
Format -> Reg -> SDoc
pprReg (Bool -> Format
archWordFormat (Platform -> Bool
target32Bit Platform
platform)) Reg
reg2
]
pprCondOpReg :: PtrString -> Format -> Cond -> Operand -> Reg -> SDoc
pprCondOpReg :: PtrString -> Format -> Cond -> Operand -> Reg -> SDoc
pprCondOpReg PtrString
name Format
format Cond
cond Operand
op1 Reg
reg2
= [SDoc] -> SDoc
hcat [
Char -> SDoc
char Char
'\t',
PtrString -> SDoc
ptext PtrString
name,
Cond -> SDoc
pprCond Cond
cond,
SDoc
space,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
SDoc
comma,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg2
]
pprCondRegReg :: PtrString -> Format -> Cond -> Reg -> Reg -> SDoc
pprCondRegReg :: PtrString -> Format -> Cond -> Reg -> Reg -> SDoc
pprCondRegReg PtrString
name Format
format Cond
cond Reg
reg1 Reg
reg2
= [SDoc] -> SDoc
hcat [
Char -> SDoc
char Char
'\t',
PtrString -> SDoc
ptext PtrString
name,
Cond -> SDoc
pprCond Cond
cond,
SDoc
space,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg1,
SDoc
comma,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg2
]
pprFormatFormatRegReg :: PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg :: PtrString -> Format -> Format -> Reg -> Reg -> SDoc
pprFormatFormatRegReg PtrString
name Format
format1 Format
format2 Reg
reg1 Reg
reg2
= [SDoc] -> SDoc
hcat [
Char -> SDoc
char Char
'\t',
PtrString -> SDoc
ptext PtrString
name,
Format -> SDoc
pprFormat Format
format1,
Format -> SDoc
pprFormat Format
format2,
SDoc
space,
Format -> Reg -> SDoc
pprReg Format
format1 Reg
reg1,
SDoc
comma,
Format -> Reg -> SDoc
pprReg Format
format2 Reg
reg2
]
pprFormatFormatOpReg :: PtrString -> Format -> Format -> Operand -> Reg -> SDoc
pprFormatFormatOpReg :: PtrString -> Format -> Format -> Operand -> Reg -> SDoc
pprFormatFormatOpReg PtrString
name Format
format1 Format
format2 Operand
op1 Reg
reg2
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format2,
Format -> Operand -> SDoc
pprOperand Format
format1 Operand
op1,
SDoc
comma,
Format -> Reg -> SDoc
pprReg Format
format2 Reg
reg2
]
pprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg :: PtrString -> Format -> Reg -> Reg -> Reg -> SDoc
pprFormatRegRegReg PtrString
name Format
format Reg
reg1 Reg
reg2 Reg
reg3
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg1,
SDoc
comma,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg2,
SDoc
comma,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg3
]
pprFormatOpOpReg :: PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
pprFormatOpOpReg :: PtrString -> Format -> Operand -> Operand -> Reg -> SDoc
pprFormatOpOpReg PtrString
name Format
format Operand
op1 Operand
op2 Reg
reg3
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op1,
SDoc
comma,
Format -> Operand -> SDoc
pprOperand Format
format Operand
op2,
SDoc
comma,
Format -> Reg -> SDoc
pprReg Format
format Reg
reg3
]
pprFormatAddrReg :: PtrString -> Format -> AddrMode -> Reg -> SDoc
pprFormatAddrReg :: PtrString -> Format -> AddrMode -> Reg -> SDoc
pprFormatAddrReg PtrString
name Format
format AddrMode
op Reg
dst
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
AddrMode -> SDoc
pprAddr AddrMode
op,
SDoc
comma,
Format -> Reg -> SDoc
pprReg Format
format Reg
dst
]
pprFormatRegAddr :: PtrString -> Format -> Reg -> AddrMode -> SDoc
pprFormatRegAddr :: PtrString -> Format -> Reg -> AddrMode -> SDoc
pprFormatRegAddr PtrString
name Format
format Reg
src AddrMode
op
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Format -> Reg -> SDoc
pprReg Format
format Reg
src,
SDoc
comma,
AddrMode -> SDoc
pprAddr AddrMode
op
]
pprShift :: PtrString -> Format -> Operand -> Operand -> SDoc
pprShift :: PtrString -> Format -> Operand -> Operand -> SDoc
pprShift PtrString
name Format
format Operand
src Operand
dest
= [SDoc] -> SDoc
hcat [
PtrString -> Format -> SDoc
pprMnemonic PtrString
name Format
format,
Format -> Operand -> SDoc
pprOperand Format
II8 Operand
src,
SDoc
comma,
Format -> Operand -> SDoc
pprOperand Format
format Operand
dest
]
pprFormatOpOpCoerce :: PtrString -> Format -> Format -> Operand -> Operand -> SDoc
pprFormatOpOpCoerce :: PtrString -> Format -> Format -> Operand -> Operand -> SDoc
pprFormatOpOpCoerce PtrString
name Format
format1 Format
format2 Operand
op1 Operand
op2
= [SDoc] -> SDoc
hcat [ Char -> SDoc
char Char
'\t', PtrString -> SDoc
ptext PtrString
name, Format -> SDoc
pprFormat Format
format1, Format -> SDoc
pprFormat Format
format2, SDoc
space,
Format -> Operand -> SDoc
pprOperand Format
format1 Operand
op1,
SDoc
comma,
Format -> Operand -> SDoc
pprOperand Format
format2 Operand
op2
]
pprCondInstr :: PtrString -> Cond -> SDoc -> SDoc
pprCondInstr :: PtrString -> Cond -> SDoc -> SDoc
pprCondInstr PtrString
name Cond
cond SDoc
arg
= [SDoc] -> SDoc
hcat [ Char -> SDoc
char Char
'\t', PtrString -> SDoc
ptext PtrString
name, Cond -> SDoc
pprCond Cond
cond, SDoc
space, SDoc
arg]