module GHC.CmmToAsm.PIC (
cmmMakeDynamicReference,
CmmMakeDynamicReferenceM(..),
ReferenceKind(..),
needImportedSymbols,
pprImportedSymbol,
pprGotDeclaration,
initializePicBase_ppc,
initializePicBase_x86
)
where
import GHC.Prelude
import qualified GHC.CmmToAsm.PPC.Instr as PPC
import qualified GHC.CmmToAsm.PPC.Regs as PPC
import qualified GHC.CmmToAsm.X86.Instr as X86
import GHC.Platform
import GHC.Platform.Reg
import GHC.CmmToAsm.Monad
import GHC.CmmToAsm.Config
import GHC.CmmToAsm.Types
import GHC.Cmm.Dataflow.Collections
import GHC.Cmm
import GHC.Cmm.CLabel
import GHC.Cmm.Utils (cmmLoadBWord)
import GHC.Types.Basic
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.FastString
data ReferenceKind
= DataReference
| CallReference
| JumpReference
deriving(ReferenceKind -> ReferenceKind -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceKind -> ReferenceKind -> Bool
$c/= :: ReferenceKind -> ReferenceKind -> Bool
== :: ReferenceKind -> ReferenceKind -> Bool
$c== :: ReferenceKind -> ReferenceKind -> Bool
Eq)
class Monad m => CmmMakeDynamicReferenceM m where
addImport :: CLabel -> m ()
instance CmmMakeDynamicReferenceM NatM where
addImport :: CLabel -> NatM ()
addImport = CLabel -> NatM ()
addImportNat
cmmMakeDynamicReference
:: CmmMakeDynamicReferenceM m
=> NCGConfig
-> ReferenceKind
-> CLabel
-> m CmmExpr
cmmMakeDynamicReference :: forall (m :: * -> *).
CmmMakeDynamicReferenceM m =>
NCGConfig -> ReferenceKind -> CLabel -> m CmmExpr
cmmMakeDynamicReference NCGConfig
config ReferenceKind
referenceKind CLabel
lbl
| Just (DynamicLinkerLabelInfo, CLabel)
_ <- CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
lbl
= forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl
| Bool
otherwise
= do let platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
case NCGConfig
-> Arch -> OS -> ReferenceKind -> CLabel -> LabelAccessStyle
howToAccessLabel
NCGConfig
config
(Platform -> Arch
platformArch Platform
platform)
(Platform -> OS
platformOS Platform
platform)
ReferenceKind
referenceKind CLabel
lbl of
LabelAccessStyle
AccessViaStub -> do
let stub :: CLabel
stub = DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
CodeStub CLabel
lbl
forall (m :: * -> *). CmmMakeDynamicReferenceM m => CLabel -> m ()
addImport CLabel
stub
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
stub
LabelAccessStyle
AccessViaSymbolPtr | Arch
ArchAArch64 <- Platform -> Arch
platformArch Platform
platform -> do
let symbolPtr :: CLabel
symbolPtr = DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
SymbolPtr CLabel
lbl
forall (m :: * -> *). CmmMakeDynamicReferenceM m => CLabel -> m ()
addImport CLabel
symbolPtr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NCGConfig -> CLabel -> CmmExpr
cmmMakePicReference NCGConfig
config CLabel
symbolPtr
LabelAccessStyle
AccessViaSymbolPtr -> do
let symbolPtr :: CLabel
symbolPtr = DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
SymbolPtr CLabel
lbl
forall (m :: * -> *). CmmMakeDynamicReferenceM m => CLabel -> m ()
addImport CLabel
symbolPtr
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr
cmmLoadBWord Platform
platform (NCGConfig -> CLabel -> CmmExpr
cmmMakePicReference NCGConfig
config CLabel
symbolPtr)
LabelAccessStyle
AccessDirectly -> case ReferenceKind
referenceKind of
ReferenceKind
DataReference -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ NCGConfig -> CLabel -> CmmExpr
cmmMakePicReference NCGConfig
config CLabel
lbl
ReferenceKind
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl
cmmMakePicReference :: NCGConfig -> CLabel -> CmmExpr
cmmMakePicReference :: NCGConfig -> CLabel -> CmmExpr
cmmMakePicReference NCGConfig
config CLabel
lbl
| OS
OSMinGW32 <- Platform -> OS
platformOS Platform
platform
= CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl
| Arch
ArchAArch64 <- Platform -> Arch
platformArch Platform
platform
= CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl
| OS
OSAIX <- Platform -> OS
platformOS Platform
platform
= MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W32)
[ CmmReg -> CmmExpr
CmmReg (GlobalReg -> CmmReg
CmmGlobal GlobalReg
PicBaseReg)
, CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ Width -> Arch -> OS -> CLabel -> CmmLit
picRelative (Platform -> Width
wordWidth Platform
platform)
(Platform -> Arch
platformArch Platform
platform)
(Platform -> OS
platformOS Platform
platform)
CLabel
lbl ]
| ArchPPC_64 PPC_64ABI
_ <- Platform -> Arch
platformArch Platform
platform
= MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add Width
W32)
[ CmmReg -> CmmExpr
CmmReg (GlobalReg -> CmmReg
CmmGlobal GlobalReg
PicBaseReg)
, CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ Width -> Arch -> OS -> CLabel -> CmmLit
picRelative (Platform -> Width
wordWidth Platform
platform)
(Platform -> Arch
platformArch Platform
platform)
(Platform -> OS
platformOS Platform
platform)
CLabel
lbl ]
| (NCGConfig -> Bool
ncgPIC NCGConfig
config Bool -> Bool -> Bool
|| NCGConfig -> Bool
ncgExternalDynamicRefs NCGConfig
config)
Bool -> Bool -> Bool
&& CLabel -> Bool
absoluteLabel CLabel
lbl
= MachOp -> [CmmExpr] -> CmmExpr
CmmMachOp (Width -> MachOp
MO_Add (Platform -> Width
wordWidth Platform
platform))
[ CmmReg -> CmmExpr
CmmReg (GlobalReg -> CmmReg
CmmGlobal GlobalReg
PicBaseReg)
, CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ Width -> Arch -> OS -> CLabel -> CmmLit
picRelative (Platform -> Width
wordWidth Platform
platform)
(Platform -> Arch
platformArch Platform
platform)
(Platform -> OS
platformOS Platform
platform)
CLabel
lbl ]
| Bool
otherwise
= CmmLit -> CmmExpr
CmmLit forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
absoluteLabel :: CLabel -> Bool
absoluteLabel :: CLabel -> Bool
absoluteLabel CLabel
lbl
= case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
lbl of
Just (DynamicLinkerLabelInfo
GotSymbolPtr, CLabel
_) -> Bool
False
Just (DynamicLinkerLabelInfo
GotSymbolOffset, CLabel
_) -> Bool
False
Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> Bool
True
data LabelAccessStyle
= AccessViaStub
| AccessViaSymbolPtr
| AccessDirectly
howToAccessLabel :: NCGConfig -> Arch -> OS -> ReferenceKind -> CLabel -> LabelAccessStyle
howToAccessLabel :: NCGConfig
-> Arch -> OS -> ReferenceKind -> CLabel -> LabelAccessStyle
howToAccessLabel NCGConfig
config Arch
_arch OS
OSMinGW32 ReferenceKind
_kind CLabel
lbl
| Bool -> Bool
not (NCGConfig -> Bool
ncgExternalDynamicRefs NCGConfig
config)
= LabelAccessStyle
AccessDirectly
| NCGConfig -> CLabel -> Bool
labelDynamic NCGConfig
config CLabel
lbl
= LabelAccessStyle
AccessViaSymbolPtr
| Bool
otherwise
= LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
config Arch
ArchAArch64 OS
_os ReferenceKind
_kind CLabel
lbl
| Bool -> Bool
not (NCGConfig -> Bool
ncgExternalDynamicRefs NCGConfig
config)
= LabelAccessStyle
AccessDirectly
| NCGConfig -> CLabel -> Bool
labelDynamic NCGConfig
config CLabel
lbl
= LabelAccessStyle
AccessViaSymbolPtr
| Bool
otherwise
= LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
config Arch
arch OS
OSDarwin ReferenceKind
DataReference CLabel
lbl
| NCGConfig -> CLabel -> Bool
labelDynamic NCGConfig
config CLabel
lbl
= LabelAccessStyle
AccessViaSymbolPtr
| Arch
arch forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
, NCGConfig -> Bool
ncgPIC NCGConfig
config Bool -> Bool -> Bool
&& CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
= LabelAccessStyle
AccessViaSymbolPtr
| Bool
otherwise
= LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
config Arch
arch OS
OSDarwin ReferenceKind
JumpReference CLabel
lbl
| Arch
arch forall a. Eq a => a -> a -> Bool
== Arch
ArchX86 Bool -> Bool -> Bool
|| Arch
arch forall a. Eq a => a -> a -> Bool
== Arch
ArchX86_64 Bool -> Bool -> Bool
|| Arch
arch forall a. Eq a => a -> a -> Bool
== Arch
ArchAArch64
, NCGConfig -> CLabel -> Bool
labelDynamic NCGConfig
config CLabel
lbl
= LabelAccessStyle
AccessViaSymbolPtr
howToAccessLabel NCGConfig
config Arch
arch OS
OSDarwin ReferenceKind
_kind CLabel
lbl
| Arch
arch forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
, Arch
arch forall a. Eq a => a -> a -> Bool
/= Arch
ArchAArch64
, NCGConfig -> CLabel -> Bool
labelDynamic NCGConfig
config CLabel
lbl
= LabelAccessStyle
AccessViaStub
| Bool
otherwise
= LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
_config Arch
_arch OS
OSAIX ReferenceKind
kind CLabel
_lbl
= case ReferenceKind
kind of
ReferenceKind
DataReference -> LabelAccessStyle
AccessViaSymbolPtr
ReferenceKind
CallReference -> LabelAccessStyle
AccessDirectly
ReferenceKind
JumpReference -> LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
_config (ArchPPC_64 PPC_64ABI
_) OS
os ReferenceKind
kind CLabel
_lbl
| OS -> Bool
osElfTarget OS
os
= case ReferenceKind
kind of
ReferenceKind
DataReference -> LabelAccessStyle
AccessViaSymbolPtr
ReferenceKind
JumpReference -> LabelAccessStyle
AccessViaSymbolPtr
ReferenceKind
_ -> LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
config Arch
_arch OS
os ReferenceKind
_kind CLabel
_lbl
| OS -> Bool
osElfTarget OS
os
, Bool -> Bool
not (NCGConfig -> Bool
ncgPIC NCGConfig
config) Bool -> Bool -> Bool
&&
Bool -> Bool
not (NCGConfig -> Bool
ncgExternalDynamicRefs NCGConfig
config)
= LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
config Arch
arch OS
os ReferenceKind
DataReference CLabel
lbl
| OS -> Bool
osElfTarget OS
os
= case () of
()
_ | NCGConfig -> CLabel -> Bool
labelDynamic NCGConfig
config CLabel
lbl
-> LabelAccessStyle
AccessViaSymbolPtr
| Arch
arch forall a. Eq a => a -> a -> Bool
== Arch
ArchPPC
, NCGConfig -> Bool
ncgPIC NCGConfig
config
-> LabelAccessStyle
AccessViaSymbolPtr
| Bool
otherwise
-> LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
config Arch
arch OS
os ReferenceKind
CallReference CLabel
lbl
| OS -> Bool
osElfTarget OS
os
, NCGConfig -> CLabel -> Bool
labelDynamic NCGConfig
config CLabel
lbl Bool -> Bool -> Bool
&& Bool -> Bool
not (NCGConfig -> Bool
ncgPIC NCGConfig
config)
= LabelAccessStyle
AccessDirectly
| OS -> Bool
osElfTarget OS
os
, Arch
arch forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86
, NCGConfig -> CLabel -> Bool
labelDynamic NCGConfig
config CLabel
lbl
, NCGConfig -> Bool
ncgPIC NCGConfig
config
= LabelAccessStyle
AccessViaStub
howToAccessLabel NCGConfig
config Arch
_arch OS
os ReferenceKind
_kind CLabel
lbl
| OS -> Bool
osElfTarget OS
os
= if NCGConfig -> CLabel -> Bool
labelDynamic NCGConfig
config CLabel
lbl
then LabelAccessStyle
AccessViaSymbolPtr
else LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
config Arch
_arch OS
_os ReferenceKind
_kind CLabel
_lbl
| Bool -> Bool
not (NCGConfig -> Bool
ncgPIC NCGConfig
config)
= LabelAccessStyle
AccessDirectly
| Bool
otherwise
= forall a. String -> a
panic String
"howToAccessLabel: PIC not defined for this platform"
picRelative :: Width -> Arch -> OS -> CLabel -> CmmLit
picRelative :: Width -> Arch -> OS -> CLabel -> CmmLit
picRelative Width
width Arch
arch OS
OSDarwin CLabel
lbl
| Arch
arch forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
= CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
lbl CLabel
mkPicBaseLabel Int
0 Width
width
picRelative Width
width Arch
_ OS
OSAIX CLabel
lbl
= CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
lbl CLabel
gotLabel Int
0 Width
width
picRelative Width
width Arch
ArchPPC OS
os CLabel
lbl
| OS -> Bool
osElfTarget OS
os
= CLabel -> CLabel -> Int -> Width -> CmmLit
CmmLabelDiffOff CLabel
lbl CLabel
gotLabel Int
0 Width
width
picRelative Width
_ Arch
arch OS
os CLabel
lbl
| OS -> Bool
osElfTarget OS
os Bool -> Bool -> Bool
|| (OS
os forall a. Eq a => a -> a -> Bool
== OS
OSDarwin Bool -> Bool -> Bool
&& Arch
arch forall a. Eq a => a -> a -> Bool
== Arch
ArchX86_64)
= let result :: CmmLit
result
| Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl') <- CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
lbl
= CLabel -> CmmLit
CmmLabel forall a b. (a -> b) -> a -> b
$ DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
GotSymbolPtr CLabel
lbl'
| Bool
otherwise
= CLabel -> CmmLit
CmmLabel forall a b. (a -> b) -> a -> b
$ DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
GotSymbolOffset CLabel
lbl
in CmmLit
result
picRelative Width
_ Arch
_ OS
_ CLabel
_
= forall a. String -> a
panic String
"GHC.CmmToAsm.PIC.picRelative undefined for this platform"
needImportedSymbols :: NCGConfig -> Bool
needImportedSymbols :: NCGConfig -> Bool
needImportedSymbols NCGConfig
config
| OS
os forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
, Arch
arch forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
= Bool
True
| OS
os forall a. Eq a => a -> a -> Bool
== OS
OSAIX
= Bool
True
| OS -> Bool
osElfTarget OS
os
, Arch
arch forall a. Eq a => a -> a -> Bool
== Arch
ArchPPC
= NCGConfig -> Bool
ncgPIC NCGConfig
config Bool -> Bool -> Bool
|| NCGConfig -> Bool
ncgExternalDynamicRefs NCGConfig
config
| OS -> Bool
osElfTarget OS
os
, Arch
arch forall a. Eq a => a -> a -> Bool
== PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
|| Arch
arch forall a. Eq a => a -> a -> Bool
== PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
= Bool
True
| OS -> Bool
osElfTarget OS
os
, Arch
arch forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
&& Arch
arch forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
= NCGConfig -> Bool
ncgExternalDynamicRefs NCGConfig
config Bool -> Bool -> Bool
&&
Bool -> Bool
not (NCGConfig -> Bool
ncgPIC NCGConfig
config)
| Bool
otherwise
= Bool
False
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
arch :: Arch
arch = Platform -> Arch
platformArch Platform
platform
os :: OS
os = Platform -> OS
platformOS Platform
platform
gotLabel :: CLabel
gotLabel :: CLabel
gotLabel
= FastString
-> Maybe Int -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel
(String -> FastString
fsLit String
".LCTOC1")
forall a. Maybe a
Nothing ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsData
pprGotDeclaration :: NCGConfig -> SDoc
pprGotDeclaration :: NCGConfig -> SDoc
pprGotDeclaration NCGConfig
config = case (Arch
arch,OS
os) of
(Arch
ArchX86, OS
OSDarwin)
| NCGConfig -> Bool
ncgPIC NCGConfig
config
-> [SDoc] -> SDoc
vcat [
String -> SDoc
text String
".section __TEXT,__textcoal_nt,coalesced,no_toc",
String -> SDoc
text String
".weak_definition ___i686.get_pc_thunk.ax",
String -> SDoc
text String
".private_extern ___i686.get_pc_thunk.ax",
String -> SDoc
text String
"___i686.get_pc_thunk.ax:",
String -> SDoc
text String
"\tmovl (%esp), %eax",
String -> SDoc
text String
"\tret" ]
(Arch
_, OS
OSDarwin) -> SDoc
empty
(Arch
_, OS
OSAIX)
-> [SDoc] -> SDoc
vcat forall a b. (a -> b) -> a -> b
$ [ String -> SDoc
text String
".toc"
, String -> SDoc
text String
".tc ghc_toc_table[TC],.LCTOC1"
, String -> SDoc
text String
".csect ghc_toc_table[RW]"
, String -> SDoc
text String
".set .LCTOC1,$+0x8000"
]
(ArchPPC_64 PPC_64ABI
ELF_V1, OS
_)
-> String -> SDoc
text String
".section \".toc\",\"aw\""
(ArchPPC_64 PPC_64ABI
ELF_V2, OS
_)
-> [SDoc] -> SDoc
vcat [ String -> SDoc
text String
".abiversion 2",
String -> SDoc
text String
".section \".toc\",\"aw\""
]
(Arch
arch, OS
os)
| OS -> Bool
osElfTarget OS
os
, Arch
arch forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
&& Arch
arch forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
, Bool -> Bool
not (NCGConfig -> Bool
ncgPIC NCGConfig
config)
-> SDoc
empty
| OS -> Bool
osElfTarget OS
os
, Arch
arch forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
&& Arch
arch forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
-> [SDoc] -> SDoc
vcat [
String -> SDoc
text String
".section \".got2\",\"aw\"",
String -> SDoc
text String
".LCTOC1 = .+32768" ]
(Arch, OS)
_ -> forall a. String -> a
panic String
"pprGotDeclaration: no match"
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
arch :: Arch
arch = Platform -> Arch
platformArch Platform
platform
os :: OS
os = Platform -> OS
platformOS Platform
platform
pprImportedSymbol :: NCGConfig -> CLabel -> SDoc
pprImportedSymbol :: NCGConfig -> CLabel -> SDoc
pprImportedSymbol NCGConfig
config CLabel
importedLbl = case (Arch
arch,OS
os) of
(Arch
ArchX86, OS
OSDarwin)
| Just (DynamicLinkerLabelInfo
CodeStub, CLabel
lbl) <- CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl
-> if Bool -> Bool
not Bool
pic
then
[SDoc] -> SDoc
vcat [
String -> SDoc
text String
".symbol_stub",
String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"$stub:"),
String -> SDoc
text String
"\t.indirect_symbol" SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
ppr_lbl CLabel
lbl,
String -> SDoc
text String
"\tjmp *L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$lazy_ptr",
String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub_binder:",
String -> SDoc
text String
"\tpushl $L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$lazy_ptr",
String -> SDoc
text String
"\tjmp dyld_stub_binding_helper"
]
else
[SDoc] -> SDoc
vcat [
String -> SDoc
text String
".section __TEXT,__picsymbolstub2,"
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"symbol_stubs,pure_instructions,25",
String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"$stub:"),
String -> SDoc
text String
"\t.indirect_symbol" SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
ppr_lbl CLabel
lbl,
String -> SDoc
text String
"\tcall ___i686.get_pc_thunk.ax",
String -> SDoc
text String
"1:",
String -> SDoc
text String
"\tmovl L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$lazy_ptr-1b(%eax),%edx",
String -> SDoc
text String
"\tjmp *%edx",
String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub_binder:",
String -> SDoc
text String
"\tlea L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$lazy_ptr-1b(%eax),%eax",
String -> SDoc
text String
"\tpushl %eax",
String -> SDoc
text String
"\tjmp dyld_stub_binding_helper"
]
SDoc -> SDoc -> SDoc
$+$ [SDoc] -> SDoc
vcat [ String -> SDoc
text String
".section __DATA, __la_sym_ptr"
SDoc -> SDoc -> SDoc
<> (if Bool
pic then Int -> SDoc
int Int
2 else Int -> SDoc
int Int
3)
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
",lazy_symbol_pointers",
String -> SDoc
text String
"L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl SDoc -> SDoc -> SDoc
<> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"$lazy_ptr:"),
String -> SDoc
text String
"\t.indirect_symbol" SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
ppr_lbl CLabel
lbl,
String -> SDoc
text String
"\t.long L" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl
SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$stub_binder"]
| Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl) <- CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl
-> [SDoc] -> SDoc
vcat [
String -> SDoc
text String
".non_lazy_symbol_pointer",
Char -> SDoc
char Char
'L' SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl SDoc -> SDoc -> SDoc
<> String -> SDoc
text String
"$non_lazy_ptr:",
String -> SDoc
text String
"\t.indirect_symbol" SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
ppr_lbl CLabel
lbl,
String -> SDoc
text String
"\t.long\t0"]
| Bool
otherwise
-> SDoc
empty
(Arch
ArchAArch64, OS
OSDarwin)
-> SDoc
empty
(Arch
_, OS
OSAIX) -> case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl of
Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl)
-> [SDoc] -> SDoc
vcat [
String -> SDoc
text String
"LC.." SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':',
String -> SDoc
text String
"\t.long" SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
ppr_lbl CLabel
lbl ]
Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> SDoc
empty
(ArchPPC_64 PPC_64ABI
_, OS
_)
| OS -> Bool
osElfTarget OS
os
-> case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl of
Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl)
-> [SDoc] -> SDoc
vcat [
String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':',
String -> SDoc
text String
"\t.quad" SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
ppr_lbl CLabel
lbl ]
Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> SDoc
empty
(Arch, OS)
_ | OS -> Bool
osElfTarget OS
os
-> case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl of
Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl)
-> let symbolSize :: PtrString
symbolSize = case NCGConfig -> Width
ncgWordWidth NCGConfig
config of
Width
W32 -> String -> PtrString
sLit String
"\t.long"
Width
W64 -> String -> PtrString
sLit String
"\t.quad"
Width
_ -> forall a. String -> a
panic String
"Unknown wordRep in pprImportedSymbol"
in [SDoc] -> SDoc
vcat [
String -> SDoc
text String
".section \".got2\", \"aw\"",
String -> SDoc
text String
".LC_" SDoc -> SDoc -> SDoc
<> CLabel -> SDoc
ppr_lbl CLabel
lbl SDoc -> SDoc -> SDoc
<> Char -> SDoc
char Char
':',
PtrString -> SDoc
ptext PtrString
symbolSize SDoc -> SDoc -> SDoc
<+> CLabel -> SDoc
ppr_lbl CLabel
lbl ]
Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> SDoc
empty
(Arch, OS)
_ -> forall a. String -> a
panic String
"PIC.pprImportedSymbol: no match"
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
ppr_lbl :: CLabel -> SDoc
ppr_lbl = Platform -> LabelStyle -> CLabel -> SDoc
pprCLabel Platform
platform LabelStyle
AsmStyle
arch :: Arch
arch = Platform -> Arch
platformArch Platform
platform
os :: OS
os = Platform -> OS
platformOS Platform
platform
pic :: Bool
pic = NCGConfig -> Bool
ncgPIC NCGConfig
config
initializePicBase_ppc
:: Arch -> OS -> Reg
-> [NatCmmDecl RawCmmStatics PPC.Instr]
-> NatM [NatCmmDecl RawCmmStatics PPC.Instr]
initializePicBase_ppc :: Arch
-> OS
-> Reg
-> [NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
initializePicBase_ppc Arch
ArchPPC OS
os Reg
picReg
(CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live (ListGraph [GenBasicBlock Instr]
blocks) : [NatCmmDecl RawCmmStatics Instr]
statics)
| OS -> Bool
osElfTarget OS
os
= do
let
gotOffset :: Imm
gotOffset = Imm -> Imm -> Imm
PPC.ImmConstantDiff
(CLabel -> Imm
PPC.ImmCLbl CLabel
gotLabel)
(CLabel -> Imm
PPC.ImmCLbl CLabel
mkPicBaseLabel)
blocks' :: [GenBasicBlock Instr]
blocks' = case [GenBasicBlock Instr]
blocks of
[] -> []
(GenBasicBlock Instr
b:[GenBasicBlock Instr]
bs) -> GenBasicBlock Instr -> GenBasicBlock Instr
fetchPC GenBasicBlock Instr
b forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock Instr -> GenBasicBlock Instr
maybeFetchPC [GenBasicBlock Instr]
bs
maybeFetchPC :: GenBasicBlock Instr -> GenBasicBlock Instr
maybeFetchPC b :: GenBasicBlock Instr
b@(BasicBlock BlockId
bID [Instr]
_)
| BlockId
bID forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> Bool
`mapMember` LabelMap RawCmmStatics
info = GenBasicBlock Instr -> GenBasicBlock Instr
fetchPC GenBasicBlock Instr
b
| Bool
otherwise = GenBasicBlock Instr
b
fetchPC :: GenBasicBlock Instr -> GenBasicBlock Instr
fetchPC (BasicBlock BlockId
bID [Instr]
insns) =
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID (Reg -> Instr
PPC.FETCHPC Reg
picReg
forall a. a -> [a] -> [a]
: Reg -> Reg -> Imm -> Instr
PPC.ADDIS Reg
picReg Reg
picReg (Imm -> Imm
PPC.HA Imm
gotOffset)
forall a. a -> [a] -> [a]
: Reg -> Reg -> RI -> Instr
PPC.ADD Reg
picReg Reg
picReg
(Imm -> RI
PPC.RIImm (Imm -> Imm
PPC.LO Imm
gotOffset))
forall a. a -> [a] -> [a]
: Reg -> Reg -> Instr
PPC.MR Reg
PPC.r30 Reg
picReg
forall a. a -> [a] -> [a]
: [Instr]
insns)
forall (m :: * -> *) a. Monad m => a -> m a
return (forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live (forall i. [GenBasicBlock i] -> ListGraph i
ListGraph [GenBasicBlock Instr]
blocks') forall a. a -> [a] -> [a]
: [NatCmmDecl RawCmmStatics Instr]
statics)
initializePicBase_ppc Arch
_ OS
_ Reg
_ [NatCmmDecl RawCmmStatics Instr]
_
= forall a. String -> a
panic String
"initializePicBase_ppc: not needed"
initializePicBase_x86
:: Arch -> OS -> Reg
-> [NatCmmDecl (Alignment, RawCmmStatics) X86.Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) X86.Instr]
initializePicBase_x86 :: Arch
-> OS
-> Reg
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
initializePicBase_x86 Arch
ArchX86 OS
os Reg
picReg
(CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live (ListGraph [GenBasicBlock Instr]
blocks) : [NatCmmDecl (Alignment, RawCmmStatics) Instr]
statics)
| OS -> Bool
osElfTarget OS
os
= forall (m :: * -> *) a. Monad m => a -> m a
return (forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live (forall i. [GenBasicBlock i] -> ListGraph i
ListGraph [GenBasicBlock Instr]
blocks') forall a. a -> [a] -> [a]
: [NatCmmDecl (Alignment, RawCmmStatics) Instr]
statics)
where blocks' :: [GenBasicBlock Instr]
blocks' = case [GenBasicBlock Instr]
blocks of
[] -> []
(GenBasicBlock Instr
b:[GenBasicBlock Instr]
bs) -> GenBasicBlock Instr -> GenBasicBlock Instr
fetchGOT GenBasicBlock Instr
b forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map GenBasicBlock Instr -> GenBasicBlock Instr
maybeFetchGOT [GenBasicBlock Instr]
bs
maybeFetchGOT :: GenBasicBlock Instr -> GenBasicBlock Instr
maybeFetchGOT b :: GenBasicBlock Instr
b@(BasicBlock BlockId
bID [Instr]
_)
| BlockId
bID forall (map :: * -> *) a. IsMap map => KeyOf map -> map a -> Bool
`mapMember` LabelMap RawCmmStatics
info = GenBasicBlock Instr -> GenBasicBlock Instr
fetchGOT GenBasicBlock Instr
b
| Bool
otherwise = GenBasicBlock Instr
b
fetchGOT :: GenBasicBlock Instr -> GenBasicBlock Instr
fetchGOT (BasicBlock BlockId
bID [Instr]
insns) =
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID (Reg -> Instr
X86.FETCHGOT Reg
picReg forall a. a -> [a] -> [a]
: [Instr]
insns)
initializePicBase_x86 Arch
ArchX86 OS
OSDarwin Reg
picReg
(CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live (ListGraph (GenBasicBlock Instr
entry:[GenBasicBlock Instr]
blocks)) : [NatCmmDecl (Alignment, RawCmmStatics) Instr]
statics)
= forall (m :: * -> *) a. Monad m => a -> m a
return (forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalReg]
live (forall i. [GenBasicBlock i] -> ListGraph i
ListGraph (GenBasicBlock Instr
block'forall a. a -> [a] -> [a]
:[GenBasicBlock Instr]
blocks)) forall a. a -> [a] -> [a]
: [NatCmmDecl (Alignment, RawCmmStatics) Instr]
statics)
where BasicBlock BlockId
bID [Instr]
insns = GenBasicBlock Instr
entry
block' :: GenBasicBlock Instr
block' = forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID (Reg -> Instr
X86.FETCHPC Reg
picReg forall a. a -> [a] -> [a]
: [Instr]
insns)
initializePicBase_x86 Arch
_ OS
_ Reg
_ [NatCmmDecl (Alignment, RawCmmStatics) Instr]
_
= forall a. String -> a
panic String
"initializePicBase_x86: not needed"