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.Label
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
(ReferenceKind -> ReferenceKind -> Bool)
-> (ReferenceKind -> ReferenceKind -> Bool) -> Eq ReferenceKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReferenceKind -> ReferenceKind -> Bool
== :: ReferenceKind -> ReferenceKind -> Bool
$c/= :: ReferenceKind -> ReferenceKind -> Bool
/= :: 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
= CmmExpr -> m CmmExpr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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
CLabel -> m ()
forall (m :: * -> *). CmmMakeDynamicReferenceM m => CLabel -> m ()
addImport CLabel
stub
CmmExpr -> m CmmExpr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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
CLabel -> m ()
forall (m :: * -> *). CmmMakeDynamicReferenceM m => CLabel -> m ()
addImport CLabel
symbolPtr
CmmExpr -> m CmmExpr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ NCGConfig -> CLabel -> CmmExpr
cmmMakePicReference NCGConfig
config CLabel
symbolPtr
LabelAccessStyle
AccessViaSymbolPtr | Arch
ArchRISCV64 <- Platform -> Arch
platformArch Platform
platform -> do
let symbolPtr :: CLabel
symbolPtr = DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
SymbolPtr CLabel
lbl
CLabel -> m ()
forall (m :: * -> *). CmmMakeDynamicReferenceM m => CLabel -> m ()
addImport CLabel
symbolPtr
CmmExpr -> m CmmExpr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
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
CLabel -> m ()
forall (m :: * -> *). CmmMakeDynamicReferenceM m => CLabel -> m ()
addImport CLabel
symbolPtr
CmmExpr -> m CmmExpr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ Platform -> CmmExpr -> CmmExpr
cmmLoadBWord Platform
platform (NCGConfig -> CLabel -> CmmExpr
cmmMakePicReference NCGConfig
config CLabel
symbolPtr)
LabelAccessStyle
AccessDirectly | Arch
ArchWasm32 <- Platform -> Arch
platformArch Platform
platform ->
CmmExpr -> m CmmExpr
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl
LabelAccessStyle
AccessDirectly -> case ReferenceKind
referenceKind of
ReferenceKind
DataReference -> CmmExpr -> m CmmExpr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ NCGConfig -> CLabel -> CmmExpr
cmmMakePicReference NCGConfig
config CLabel
lbl
ReferenceKind
_ -> CmmExpr -> m CmmExpr
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CmmExpr -> m CmmExpr) -> CmmExpr -> m CmmExpr
forall a b. (a -> b) -> a -> b
$ CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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 (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl
| Arch
ArchAArch64 <- Platform -> Arch
platformArch Platform
platform
= CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
forall a b. (a -> b) -> a -> b
$ CLabel -> CmmLit
CmmLabel CLabel
lbl
| Arch
ArchRISCV64 <- Platform -> Arch
platformArch Platform
platform
= CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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 (GlobalRegUse -> CmmReg
CmmGlobal (GlobalRegUse -> CmmReg) -> GlobalRegUse -> CmmReg
forall a b. (a -> b) -> a -> b
$ GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
PicBaseReg (Platform -> CmmType
bWord Platform
platform))
, CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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 (GlobalRegUse -> CmmReg
CmmGlobal (GlobalRegUse -> CmmReg) -> GlobalRegUse -> CmmReg
forall a b. (a -> b) -> a -> b
$ GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
PicBaseReg (Platform -> CmmType
bWord Platform
platform))
, CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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 (GlobalRegUse -> CmmReg
CmmGlobal (GlobalRegUse -> CmmReg) -> GlobalRegUse -> CmmReg
forall a b. (a -> b) -> a -> b
$ GlobalReg -> CmmType -> GlobalRegUse
GlobalRegUse GlobalReg
PicBaseReg (Platform -> CmmType
bWord Platform
platform))
, CmmLit -> CmmExpr
CmmLit (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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 (CmmLit -> CmmExpr) -> CmmLit -> CmmExpr
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
ncgLabelDynamic :: NCGConfig -> CLabel -> Bool
ncgLabelDynamic :: NCGConfig -> CLabel -> Bool
ncgLabelDynamic NCGConfig
config = Module -> Platform -> Bool -> CLabel -> Bool
labelDynamic (NCGConfig -> Module
ncgThisModule NCGConfig
config)
(NCGConfig -> Platform
ncgPlatform NCGConfig
config)
(NCGConfig -> Bool
ncgExternalDynamicRefs NCGConfig
config)
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
ncgLabelDynamic 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
ncgLabelDynamic NCGConfig
config CLabel
lbl
= LabelAccessStyle
AccessViaSymbolPtr
| Bool
otherwise
= LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
config Arch
arch OS
OSDarwin ReferenceKind
DataReference CLabel
lbl
| NCGConfig -> CLabel -> Bool
ncgLabelDynamic NCGConfig
config CLabel
lbl
= LabelAccessStyle
AccessViaSymbolPtr
| Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
, Bool -> Bool
not (Module -> CLabel -> Bool
isLocalCLabel (NCGConfig -> Module
ncgThisModule NCGConfig
config) CLabel
lbl)
, NCGConfig -> Bool
ncgPIC NCGConfig
config
, CLabel -> Bool
externallyVisibleCLabel CLabel
lbl
= LabelAccessStyle
AccessViaSymbolPtr
| Bool
otherwise
= LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
config Arch
_ OS
OSDarwin ReferenceKind
JumpReference CLabel
lbl
| NCGConfig -> CLabel -> Bool
ncgLabelDynamic NCGConfig
config CLabel
lbl
= LabelAccessStyle
AccessViaSymbolPtr
howToAccessLabel NCGConfig
_ Arch
_ OS
OSDarwin ReferenceKind
_ CLabel
_
= 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
ncgLabelDynamic NCGConfig
config CLabel
lbl
-> LabelAccessStyle
AccessViaSymbolPtr
| Arch
arch Arch -> Arch -> Bool
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
ncgLabelDynamic NCGConfig
config CLabel
lbl
, Bool -> Bool
not (NCGConfig -> Bool
ncgPIC NCGConfig
config)
= LabelAccessStyle
AccessDirectly
| OS -> Bool
osElfTarget OS
os
, Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86
, NCGConfig -> CLabel -> Bool
ncgLabelDynamic 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
ncgLabelDynamic NCGConfig
config CLabel
lbl
then LabelAccessStyle
AccessViaSymbolPtr
else LabelAccessStyle
AccessDirectly
howToAccessLabel NCGConfig
_ Arch
ArchWasm32 OS
_ ReferenceKind
_ CLabel
_
= 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
= String -> LabelAccessStyle
forall a. HasCallStack => 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 Arch -> Arch -> Bool
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 OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin Bool -> Bool -> Bool
&& Arch
arch Arch -> Arch -> Bool
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 (CLabel -> CmmLit) -> CLabel -> CmmLit
forall a b. (a -> b) -> a -> b
$ DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
GotSymbolPtr CLabel
lbl'
| Bool
otherwise
= CLabel -> CmmLit
CmmLabel (CLabel -> CmmLit) -> CLabel -> CmmLit
forall a b. (a -> b) -> a -> b
$ DynamicLinkerLabelInfo -> CLabel -> CLabel
mkDynamicLinkerLabel DynamicLinkerLabelInfo
GotSymbolOffset CLabel
lbl
in CmmLit
result
picRelative Width
_ Arch
_ OS
_ CLabel
_
= String -> CmmLit
forall a. HasCallStack => String -> a
panic String
"GHC.CmmToAsm.PIC.picRelative undefined for this platform"
needImportedSymbols :: NCGConfig -> Bool
needImportedSymbols :: NCGConfig -> Bool
needImportedSymbols NCGConfig
config
| OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSDarwin
, Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= Arch
ArchX86_64
= Bool
True
| OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
OSAIX
= Bool
True
| OS -> Bool
osElfTarget OS
os
, Arch
arch Arch -> Arch -> Bool
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 Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
== PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
|| Arch
arch Arch -> Arch -> Bool
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 Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
&& Arch
arch Arch -> Arch -> Bool
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 -> ForeignLabelSource -> FunctionOrData -> CLabel
mkForeignLabel
(String -> FastString
fsLit String
".LCTOC1")
ForeignLabelSource
ForeignLabelInThisPackage FunctionOrData
IsData
pprGotDeclaration :: NCGConfig -> HDoc
pprGotDeclaration :: NCGConfig -> HDoc
pprGotDeclaration NCGConfig
config = case (Arch
arch,OS
os) of
(Arch
_, OS
OSDarwin) -> HDoc
forall doc. IsOutput doc => doc
empty
(Arch
_, OS
OSAIX)
-> [Line HDoc] -> HDoc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ [ String -> HLine
forall doc. IsLine doc => String -> doc
text String
".toc"
, String -> HLine
forall doc. IsLine doc => String -> doc
text String
".tc ghc_toc_table[TC],.LCTOC1"
, String -> HLine
forall doc. IsLine doc => String -> doc
text String
".csect ghc_toc_table[RW]"
, String -> HLine
forall doc. IsLine doc => String -> doc
text String
".set .LCTOC1,$+0x8000"
]
(ArchPPC_64 PPC_64ABI
ELF_V1, OS
_)
-> Line HDoc -> HDoc
forall doc. IsDoc doc => Line doc -> doc
line (Line HDoc -> HDoc) -> Line HDoc -> HDoc
forall a b. (a -> b) -> a -> b
$ String -> Line HDoc
forall doc. IsLine doc => String -> doc
text String
".section \".toc\",\"aw\""
(ArchPPC_64 PPC_64ABI
ELF_V2, OS
_)
-> [Line HDoc] -> HDoc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ [ String -> HLine
forall doc. IsLine doc => String -> doc
text String
".abiversion 2",
String -> HLine
forall doc. IsLine doc => String -> doc
text String
".section \".toc\",\"aw\""
]
(Arch
arch, OS
os)
| OS -> Bool
osElfTarget OS
os
, Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
&& Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
, Bool -> Bool
not (NCGConfig -> Bool
ncgPIC NCGConfig
config)
-> HDoc
forall doc. IsOutput doc => doc
empty
| OS -> Bool
osElfTarget OS
os
, Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V1 Bool -> Bool -> Bool
&& Arch
arch Arch -> Arch -> Bool
forall a. Eq a => a -> a -> Bool
/= PPC_64ABI -> Arch
ArchPPC_64 PPC_64ABI
ELF_V2
-> [Line HDoc] -> HDoc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ [
String -> HLine
forall doc. IsLine doc => String -> doc
text String
".section \".got2\",\"aw\"",
String -> HLine
forall doc. IsLine doc => String -> doc
text String
".LCTOC1 = .+32768" ]
(Arch, OS)
_ -> String -> HDoc
forall a. HasCallStack => 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 -> HDoc
pprImportedSymbol :: NCGConfig -> CLabel -> HDoc
pprImportedSymbol NCGConfig
config CLabel
importedLbl = case (Arch
arch,OS
os) of
(Arch
ArchAArch64, OS
OSDarwin)
-> HDoc
forall doc. IsOutput doc => doc
empty
(Arch
_, OS
OSAIX) -> case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl of
Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl)
-> [Line HDoc] -> HDoc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ [
String -> HLine
forall doc. IsLine doc => String -> doc
text String
"LC.." HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> CLabel -> HLine
ppr_lbl CLabel
lbl HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> HLine
forall doc. IsLine doc => Char -> doc
char Char
':',
String -> HLine
forall doc. IsLine doc => String -> doc
text String
"\t.long" HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<+> CLabel -> HLine
ppr_lbl CLabel
lbl ]
Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> HDoc
forall doc. IsOutput doc => doc
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)
-> [Line HDoc] -> HDoc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ [
String -> HLine
forall doc. IsLine doc => String -> doc
text String
".LC_" HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> CLabel -> HLine
ppr_lbl CLabel
lbl HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> HLine
forall doc. IsLine doc => Char -> doc
char Char
':',
String -> HLine
forall doc. IsLine doc => String -> doc
text String
"\t.quad" HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<+> CLabel -> HLine
ppr_lbl CLabel
lbl ]
Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> HDoc
forall doc. IsOutput doc => doc
empty
(Arch, OS)
_ | OS -> Bool
osElfTarget OS
os
-> case CLabel -> Maybe (DynamicLinkerLabelInfo, CLabel)
dynamicLinkerLabelInfo CLabel
importedLbl of
Just (DynamicLinkerLabelInfo
SymbolPtr, CLabel
lbl)
-> let symbolSize :: HLine
symbolSize = case NCGConfig -> Width
ncgWordWidth NCGConfig
config of
Width
W32 -> String -> HLine
forall doc. IsLine doc => String -> doc
text String
"\t.long"
Width
W64 -> String -> HLine
forall doc. IsLine doc => String -> doc
text String
"\t.quad"
Width
_ -> String -> HLine
forall a. HasCallStack => String -> a
panic String
"Unknown wordRep in pprImportedSymbol"
in [Line HDoc] -> HDoc
forall doc. IsDoc doc => [Line doc] -> doc
lines_ [
String -> HLine
forall doc. IsLine doc => String -> doc
text String
".section \".got2\", \"aw\"",
String -> HLine
forall doc. IsLine doc => String -> doc
text String
".LC_" HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> CLabel -> HLine
ppr_lbl CLabel
lbl HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<> Char -> HLine
forall doc. IsLine doc => Char -> doc
char Char
':',
HLine
symbolSize HLine -> HLine -> HLine
forall doc. IsLine doc => doc -> doc -> doc
<+> CLabel -> HLine
ppr_lbl CLabel
lbl ]
Maybe (DynamicLinkerLabelInfo, CLabel)
_ -> HDoc
forall doc. IsOutput doc => doc
empty
(Arch, OS)
_ -> String -> HDoc
forall a. HasCallStack => String -> a
panic String
"PIC.pprImportedSymbol: no match"
where
platform :: Platform
platform = NCGConfig -> Platform
ncgPlatform NCGConfig
config
ppr_lbl :: CLabel -> HLine
ppr_lbl :: CLabel -> HLine
ppr_lbl = Platform -> CLabel -> HLine
forall doc. IsLine doc => Platform -> CLabel -> doc
pprAsmLabel Platform
platform
arch :: Arch
arch = Platform -> Arch
platformArch Platform
platform
os :: OS
os = Platform -> OS
platformOS Platform
platform
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 [GlobalRegUse]
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 GenBasicBlock Instr
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall a. a -> [a] -> [a]
: (GenBasicBlock Instr -> GenBasicBlock Instr)
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
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 BlockId -> LabelMap RawCmmStatics -> Bool
forall a. BlockId -> LabelMap 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) =
BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID (Reg -> Instr
PPC.FETCHPC Reg
picReg
Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: Reg -> Reg -> Imm -> Instr
PPC.ADDIS Reg
picReg Reg
picReg (Imm -> Imm
PPC.HA Imm
gotOffset)
Instr -> [Instr] -> [Instr]
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))
Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: Reg -> Reg -> Instr
PPC.MR Reg
PPC.r30 Reg
picReg
Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
insns)
[NatCmmDecl RawCmmStatics Instr]
-> NatM [NatCmmDecl RawCmmStatics Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelMap RawCmmStatics
-> CLabel
-> [GlobalRegUse]
-> ListGraph Instr
-> NatCmmDecl RawCmmStatics Instr
forall d h g.
h -> CLabel -> [GlobalRegUse] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalRegUse]
live ([GenBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph [GenBasicBlock Instr]
blocks') NatCmmDecl RawCmmStatics Instr
-> [NatCmmDecl RawCmmStatics Instr]
-> [NatCmmDecl RawCmmStatics Instr]
forall a. a -> [a] -> [a]
: [NatCmmDecl RawCmmStatics Instr]
statics)
initializePicBase_ppc Arch
_ OS
_ Reg
_ [NatCmmDecl RawCmmStatics Instr]
_
= String -> NatM [NatCmmDecl RawCmmStatics Instr]
forall a. HasCallStack => String -> a
panic String
"initializePicBase_ppc: not needed"
initializePicBase_x86
:: OS -> Reg
-> [NatCmmDecl (Alignment, RawCmmStatics) X86.Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) X86.Instr]
initializePicBase_x86 :: OS
-> Reg
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
initializePicBase_x86 OS
os Reg
picReg
(CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalRegUse]
live (ListGraph [GenBasicBlock Instr]
blocks) : [NatCmmDecl (Alignment, RawCmmStatics) Instr]
statics)
| OS -> Bool
osElfTarget OS
os
= [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelMap RawCmmStatics
-> CLabel
-> [GlobalRegUse]
-> ListGraph Instr
-> NatCmmDecl (Alignment, RawCmmStatics) Instr
forall d h g.
h -> CLabel -> [GlobalRegUse] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalRegUse]
live ([GenBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph [GenBasicBlock Instr]
blocks') NatCmmDecl (Alignment, RawCmmStatics) Instr
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
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 GenBasicBlock Instr
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall a. a -> [a] -> [a]
: (GenBasicBlock Instr -> GenBasicBlock Instr)
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
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 BlockId -> LabelMap RawCmmStatics -> Bool
forall a. BlockId -> LabelMap 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) =
BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID (Reg -> Instr
X86.FETCHGOT Reg
picReg Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
insns)
initializePicBase_x86 OS
OSDarwin Reg
picReg
(CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalRegUse]
live (ListGraph (GenBasicBlock Instr
entry:[GenBasicBlock Instr]
blocks)) : [NatCmmDecl (Alignment, RawCmmStatics) Instr]
statics)
= [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. a -> NatM a
forall (m :: * -> *) a. Monad m => a -> m a
return (LabelMap RawCmmStatics
-> CLabel
-> [GlobalRegUse]
-> ListGraph Instr
-> NatCmmDecl (Alignment, RawCmmStatics) Instr
forall d h g.
h -> CLabel -> [GlobalRegUse] -> g -> GenCmmDecl d h g
CmmProc LabelMap RawCmmStatics
info CLabel
lab [GlobalRegUse]
live ([GenBasicBlock Instr] -> ListGraph Instr
forall i. [GenBasicBlock i] -> ListGraph i
ListGraph (GenBasicBlock Instr
block'GenBasicBlock Instr
-> [GenBasicBlock Instr] -> [GenBasicBlock Instr]
forall a. a -> [a] -> [a]
:[GenBasicBlock Instr]
blocks)) NatCmmDecl (Alignment, RawCmmStatics) Instr
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
-> [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. a -> [a] -> [a]
: [NatCmmDecl (Alignment, RawCmmStatics) Instr]
statics)
where BasicBlock BlockId
bID [Instr]
insns = GenBasicBlock Instr
entry
block' :: GenBasicBlock Instr
block' = BlockId -> [Instr] -> GenBasicBlock Instr
forall i. BlockId -> [i] -> GenBasicBlock i
BasicBlock BlockId
bID (Reg -> Instr
X86.FETCHPC Reg
picReg Instr -> [Instr] -> [Instr]
forall a. a -> [a] -> [a]
: [Instr]
insns)
initializePicBase_x86 OS
_ Reg
_ [NatCmmDecl (Alignment, RawCmmStatics) Instr]
_
= String -> NatM [NatCmmDecl (Alignment, RawCmmStatics) Instr]
forall a. HasCallStack => String -> a
panic String
"initializePicBase_x86: not needed"