module PIC (
cmmMakeDynamicReference,
CmmMakeDynamicReferenceM(..),
ReferenceKind(..),
needImportedSymbols,
pprImportedSymbol,
pprGotDeclaration,
initializePicBase_ppc,
initializePicBase_x86
)
where
import GhcPrelude
import qualified PPC.Instr as PPC
import qualified PPC.Regs as PPC
import qualified X86.Instr as X86
import Platform
import Instruction
import Reg
import NCGMonad
import Hoopl.Collections
import Cmm
import CLabel ( CLabel, ForeignLabelSource(..), pprCLabel,
mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
dynamicLinkerLabelInfo, mkPicBaseLabel,
labelDynamic, externallyVisibleCLabel )
import CLabel ( mkForeignLabel )
import BasicTypes
import Module
import Outputable
import DynFlags
import FastString
data ReferenceKind
= DataReference
| CallReference
| JumpReference
deriving(Eq)
class Monad m => CmmMakeDynamicReferenceM m where
addImport :: CLabel -> m ()
getThisModule :: m Module
instance CmmMakeDynamicReferenceM NatM where
addImport = addImportNat
getThisModule = getThisModuleNat
cmmMakeDynamicReference
:: CmmMakeDynamicReferenceM m
=> DynFlags
-> ReferenceKind
-> CLabel
-> m CmmExpr
cmmMakeDynamicReference dflags referenceKind lbl
| Just _ <- dynamicLinkerLabelInfo lbl
= return $ CmmLit $ CmmLabel lbl
| otherwise
= do this_mod <- getThisModule
case howToAccessLabel
dflags
(platformArch $ targetPlatform dflags)
(platformOS $ targetPlatform dflags)
this_mod
referenceKind lbl of
AccessViaStub -> do
let stub = mkDynamicLinkerLabel CodeStub lbl
addImport stub
return $ CmmLit $ CmmLabel stub
AccessViaSymbolPtr -> do
let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl
addImport symbolPtr
return $ CmmLoad (cmmMakePicReference dflags symbolPtr) (bWord dflags)
AccessDirectly -> case referenceKind of
DataReference -> return $ cmmMakePicReference dflags lbl
_ -> return $ CmmLit $ CmmLabel lbl
cmmMakePicReference :: DynFlags -> CLabel -> CmmExpr
cmmMakePicReference dflags lbl
| OSMinGW32 <- platformOS $ targetPlatform dflags
= CmmLit $ CmmLabel lbl
| OSAIX <- platformOS $ targetPlatform dflags
= CmmMachOp (MO_Add W32)
[ CmmReg (CmmGlobal PicBaseReg)
, CmmLit $ picRelative dflags
(platformArch $ targetPlatform dflags)
(platformOS $ targetPlatform dflags)
lbl ]
| ArchPPC_64 _ <- platformArch $ targetPlatform dflags
= CmmMachOp (MO_Add W32)
[ CmmReg (CmmGlobal PicBaseReg)
, CmmLit $ picRelative dflags
(platformArch $ targetPlatform dflags)
(platformOS $ targetPlatform dflags)
lbl ]
| (positionIndependent dflags || gopt Opt_ExternalDynamicRefs dflags)
&& absoluteLabel lbl
= CmmMachOp (MO_Add (wordWidth dflags))
[ CmmReg (CmmGlobal PicBaseReg)
, CmmLit $ picRelative dflags
(platformArch $ targetPlatform dflags)
(platformOS $ targetPlatform dflags)
lbl ]
| otherwise
= CmmLit $ CmmLabel lbl
absoluteLabel :: CLabel -> Bool
absoluteLabel lbl
= case dynamicLinkerLabelInfo lbl of
Just (GotSymbolPtr, _) -> False
Just (GotSymbolOffset, _) -> False
_ -> True
data LabelAccessStyle
= AccessViaStub
| AccessViaSymbolPtr
| AccessDirectly
howToAccessLabel
:: DynFlags -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle
howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl
| not (gopt Opt_ExternalDynamicRefs dflags)
= AccessDirectly
| labelDynamic dflags this_mod lbl
= AccessViaSymbolPtr
| otherwise
= AccessDirectly
howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl
| labelDynamic dflags this_mod lbl
= AccessViaSymbolPtr
| arch /= ArchX86_64
, positionIndependent dflags && externallyVisibleCLabel lbl
= AccessViaSymbolPtr
| otherwise
= AccessDirectly
howToAccessLabel dflags arch OSDarwin this_mod JumpReference lbl
| arch == ArchX86 || arch == ArchX86_64
, labelDynamic dflags this_mod lbl
= AccessViaSymbolPtr
howToAccessLabel dflags arch OSDarwin this_mod _ lbl
| arch /= ArchX86_64
, labelDynamic dflags this_mod lbl
= AccessViaStub
| otherwise
= AccessDirectly
howToAccessLabel _dflags _arch OSAIX _this_mod kind _lbl
= case kind of
DataReference -> AccessViaSymbolPtr
CallReference -> AccessDirectly
JumpReference -> AccessDirectly
howToAccessLabel _ (ArchPPC_64 _) os _ kind _
| osElfTarget os
= case kind of
DataReference -> AccessViaSymbolPtr
JumpReference -> AccessViaSymbolPtr
_ -> AccessDirectly
howToAccessLabel dflags _ os _ _ _
| osElfTarget os
, not (positionIndependent dflags) &&
not (gopt Opt_ExternalDynamicRefs dflags)
= AccessDirectly
howToAccessLabel dflags arch os this_mod DataReference lbl
| osElfTarget os
= case () of
_ | labelDynamic dflags this_mod lbl
-> AccessViaSymbolPtr
| arch == ArchPPC
, positionIndependent dflags
-> AccessViaSymbolPtr
| otherwise
-> AccessDirectly
howToAccessLabel dflags arch os this_mod CallReference lbl
| osElfTarget os
, labelDynamic dflags this_mod lbl && not (positionIndependent dflags)
= AccessDirectly
| osElfTarget os
, arch /= ArchX86
, labelDynamic dflags this_mod lbl
, positionIndependent dflags
= AccessViaStub
howToAccessLabel dflags _ os this_mod _ lbl
| osElfTarget os
= if labelDynamic dflags this_mod lbl
then AccessViaSymbolPtr
else AccessDirectly
howToAccessLabel dflags _ _ _ _ _
| not (positionIndependent dflags)
= AccessDirectly
| otherwise
= panic "howToAccessLabel: PIC not defined for this platform"
picRelative :: DynFlags -> Arch -> OS -> CLabel -> CmmLit
picRelative dflags arch OSDarwin lbl
| arch /= ArchX86_64
= CmmLabelDiffOff lbl mkPicBaseLabel 0 (wordWidth dflags)
picRelative dflags _ OSAIX lbl
= CmmLabelDiffOff lbl gotLabel 0 (wordWidth dflags)
picRelative dflags ArchPPC os lbl
| osElfTarget os
= CmmLabelDiffOff lbl gotLabel 0 (wordWidth dflags)
picRelative _ arch os lbl
| osElfTarget os || (os == OSDarwin && arch == ArchX86_64)
= let result
| Just (SymbolPtr, lbl') <- dynamicLinkerLabelInfo lbl
= CmmLabel $ mkDynamicLinkerLabel GotSymbolPtr lbl'
| otherwise
= CmmLabel $ mkDynamicLinkerLabel GotSymbolOffset lbl
in result
picRelative _ _ _ _
= panic "PositionIndependentCode.picRelative undefined for this platform"
needImportedSymbols :: DynFlags -> Arch -> OS -> Bool
needImportedSymbols dflags arch os
| os == OSDarwin
, arch /= ArchX86_64
= True
| os == OSAIX
= True
| osElfTarget os
, arch == ArchPPC
= positionIndependent dflags || gopt Opt_ExternalDynamicRefs dflags
| osElfTarget os
, arch == ArchPPC_64 ELF_V1 || arch == ArchPPC_64 ELF_V2
= True
| osElfTarget os
, arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
= gopt Opt_ExternalDynamicRefs dflags &&
not (positionIndependent dflags)
| otherwise
= False
gotLabel :: CLabel
gotLabel
= mkForeignLabel
(fsLit ".LCTOC1")
Nothing ForeignLabelInThisPackage IsData
pprGotDeclaration :: DynFlags -> Arch -> OS -> SDoc
pprGotDeclaration dflags ArchX86 OSDarwin
| positionIndependent dflags
= vcat [
text ".section __TEXT,__textcoal_nt,coalesced,no_toc",
text ".weak_definition ___i686.get_pc_thunk.ax",
text ".private_extern ___i686.get_pc_thunk.ax",
text "___i686.get_pc_thunk.ax:",
text "\tmovl (%esp), %eax",
text "\tret" ]
pprGotDeclaration _ _ OSDarwin
= empty
pprGotDeclaration _ _ OSAIX
= vcat $ [ text ".toc"
, text ".tc ghc_toc_table[TC],.LCTOC1"
, text ".csect ghc_toc_table[RW]"
, text ".set .LCTOC1,$+0x8000"
]
pprGotDeclaration _ (ArchPPC_64 ELF_V1) OSLinux
= text ".section \".toc\",\"aw\""
pprGotDeclaration _ (ArchPPC_64 ELF_V2) OSLinux
= vcat [ text ".abiversion 2",
text ".section \".toc\",\"aw\""
]
pprGotDeclaration _ (ArchPPC_64 _) _
= panic "pprGotDeclaration: ArchPPC_64 only Linux supported"
pprGotDeclaration dflags arch os
| osElfTarget os
, arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
, not (positionIndependent dflags)
= empty
| osElfTarget os
, arch /= ArchPPC_64 ELF_V1 && arch /= ArchPPC_64 ELF_V2
= vcat [
text ".section \".got2\",\"aw\"",
text ".LCTOC1 = .+32768" ]
pprGotDeclaration _ _ _
= panic "pprGotDeclaration: no match"
pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc
pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC, platformOS = OSDarwin }) importedLbl
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
= case positionIndependent dflags of
False ->
vcat [
text ".symbol_stub",
text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
text "\t.indirect_symbol" <+> pprCLabel platform lbl,
text "\tlis r11,ha16(L" <> pprCLabel platform lbl
<> text "$lazy_ptr)",
text "\tlwz r12,lo16(L" <> pprCLabel platform lbl
<> text "$lazy_ptr)(r11)",
text "\tmtctr r12",
text "\taddi r11,r11,lo16(L" <> pprCLabel platform lbl
<> text "$lazy_ptr)",
text "\tbctr"
]
True ->
vcat [
text ".section __TEXT,__picsymbolstub1,"
<> text "symbol_stubs,pure_instructions,32",
text "\t.align 2",
text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
text "\t.indirect_symbol" <+> pprCLabel platform lbl,
text "\tmflr r0",
text "\tbcl 20,31,L0$" <> pprCLabel platform lbl,
text "L0$" <> pprCLabel platform lbl <> char ':',
text "\tmflr r11",
text "\taddis r11,r11,ha16(L" <> pprCLabel platform lbl
<> text "$lazy_ptr-L0$" <> pprCLabel platform lbl <> char ')',
text "\tmtlr r0",
text "\tlwzu r12,lo16(L" <> pprCLabel platform lbl
<> text "$lazy_ptr-L0$" <> pprCLabel platform lbl
<> text ")(r11)",
text "\tmtctr r12",
text "\tbctr"
]
$+$ vcat [
text ".lazy_symbol_pointer",
text "L" <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
text "\t.indirect_symbol" <+> pprCLabel platform lbl,
text "\t.long dyld_stub_binding_helper"]
| Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
= vcat [
text ".non_lazy_symbol_pointer",
char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr:",
text "\t.indirect_symbol" <+> pprCLabel platform lbl,
text "\t.long\t0"]
| otherwise
= empty
pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
= case positionIndependent dflags of
False ->
vcat [
text ".symbol_stub",
text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
text "\t.indirect_symbol" <+> pprCLabel platform lbl,
text "\tjmp *L" <> pprCLabel platform lbl
<> text "$lazy_ptr",
text "L" <> pprCLabel platform lbl
<> text "$stub_binder:",
text "\tpushl $L" <> pprCLabel platform lbl
<> text "$lazy_ptr",
text "\tjmp dyld_stub_binding_helper"
]
True ->
vcat [
text ".section __TEXT,__picsymbolstub2,"
<> text "symbol_stubs,pure_instructions,25",
text "L" <> pprCLabel platform lbl <> ptext (sLit "$stub:"),
text "\t.indirect_symbol" <+> pprCLabel platform lbl,
text "\tcall ___i686.get_pc_thunk.ax",
text "1:",
text "\tmovl L" <> pprCLabel platform lbl
<> text "$lazy_ptr-1b(%eax),%edx",
text "\tjmp *%edx",
text "L" <> pprCLabel platform lbl
<> text "$stub_binder:",
text "\tlea L" <> pprCLabel platform lbl
<> text "$lazy_ptr-1b(%eax),%eax",
text "\tpushl %eax",
text "\tjmp dyld_stub_binding_helper"
]
$+$ vcat [ text ".section __DATA, __la_sym_ptr"
<> (if positionIndependent dflags then int 2 else int 3)
<> text ",lazy_symbol_pointers",
text "L" <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"),
text "\t.indirect_symbol" <+> pprCLabel platform lbl,
text "\t.long L" <> pprCLabel platform lbl
<> text "$stub_binder"]
| Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
= vcat [
text ".non_lazy_symbol_pointer",
char 'L' <> pprCLabel platform lbl <> text "$non_lazy_ptr:",
text "\t.indirect_symbol" <+> pprCLabel platform lbl,
text "\t.long\t0"]
| otherwise
= empty
pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
= empty
pprImportedSymbol _ platform@(Platform { platformOS = OSAIX }) importedLbl
= case dynamicLinkerLabelInfo importedLbl of
Just (SymbolPtr, lbl)
-> vcat [
text "LC.." <> pprCLabel platform lbl <> char ':',
text "\t.long" <+> pprCLabel platform lbl ]
_ -> empty
pprImportedSymbol _ platform@(Platform { platformArch = ArchPPC_64 _ })
importedLbl
| osElfTarget (platformOS platform)
= case dynamicLinkerLabelInfo importedLbl of
Just (SymbolPtr, lbl)
-> vcat [
text ".section \".toc\", \"aw\"",
text ".LC_" <> pprCLabel platform lbl <> char ':',
text "\t.quad" <+> pprCLabel platform lbl ]
_ -> empty
pprImportedSymbol dflags platform importedLbl
| osElfTarget (platformOS platform)
= case dynamicLinkerLabelInfo importedLbl of
Just (SymbolPtr, lbl)
-> let symbolSize = case wordWidth dflags of
W32 -> sLit "\t.long"
W64 -> sLit "\t.quad"
_ -> panic "Unknown wordRep in pprImportedSymbol"
in vcat [
text ".section \".got2\", \"aw\"",
text ".LC_" <> pprCLabel platform lbl <> char ':',
ptext symbolSize <+> pprCLabel platform lbl ]
_ -> empty
pprImportedSymbol _ _ _
= panic "PIC.pprImportedSymbol: no match"
initializePicBase_ppc
:: Arch -> OS -> Reg
-> [NatCmmDecl CmmStatics PPC.Instr]
-> NatM [NatCmmDecl CmmStatics PPC.Instr]
initializePicBase_ppc ArchPPC os picReg
(CmmProc info lab live (ListGraph blocks) : statics)
| osElfTarget os
= do
let
gotOffset = PPC.ImmConstantDiff
(PPC.ImmCLbl gotLabel)
(PPC.ImmCLbl mkPicBaseLabel)
blocks' = case blocks of
[] -> []
(b:bs) -> fetchPC b : map maybeFetchPC bs
maybeFetchPC b@(BasicBlock bID _)
| bID `mapMember` info = fetchPC b
| otherwise = b
fetchPC (BasicBlock bID insns) =
BasicBlock bID (PPC.FETCHPC picReg
: PPC.ADDIS picReg picReg (PPC.HA gotOffset)
: PPC.ADD picReg picReg
(PPC.RIImm (PPC.LO gotOffset))
: PPC.MR PPC.r30 picReg
: insns)
return (CmmProc info lab live (ListGraph blocks') : statics)
initializePicBase_ppc ArchPPC OSDarwin picReg
(CmmProc info lab live (ListGraph (entry:blocks)) : statics)
= return (CmmProc info lab live (ListGraph (b':blocks)) : statics)
where BasicBlock bID insns = entry
b' = BasicBlock bID (PPC.FETCHPC picReg : insns)
initializePicBase_ppc _ _ _ _
= panic "initializePicBase_ppc: not needed"
initializePicBase_x86
:: Arch -> OS -> Reg
-> [NatCmmDecl (Alignment, CmmStatics) X86.Instr]
-> NatM [NatCmmDecl (Alignment, CmmStatics) X86.Instr]
initializePicBase_x86 ArchX86 os picReg
(CmmProc info lab live (ListGraph blocks) : statics)
| osElfTarget os
= return (CmmProc info lab live (ListGraph blocks') : statics)
where blocks' = case blocks of
[] -> []
(b:bs) -> fetchGOT b : map maybeFetchGOT bs
maybeFetchGOT b@(BasicBlock bID _)
| bID `mapMember` info = fetchGOT b
| otherwise = b
fetchGOT (BasicBlock bID insns) =
BasicBlock bID (X86.FETCHGOT picReg : insns)
initializePicBase_x86 ArchX86 OSDarwin picReg
(CmmProc info lab live (ListGraph (entry:blocks)) : statics)
= return (CmmProc info lab live (ListGraph (block':blocks)) : statics)
where BasicBlock bID insns = entry
block' = BasicBlock bID (X86.FETCHPC picReg : insns)
initializePicBase_x86 _ _ _ _
= panic "initializePicBase_x86: not needed"