module PIC (
cmmMakeDynamicReference,
CmmMakeDynamicReferenceM(..),
ReferenceKind(..),
needImportedSymbols,
pprImportedSymbol,
pprGotDeclaration,
initializePicBase_ppc,
initializePicBase_x86
)
where
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
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
(platformArch $ targetPlatform dflags)
(platformOS $ targetPlatform dflags)
lbl ]
| ArchPPC_64 _ <- platformArch $ targetPlatform dflags
= CmmMachOp (MO_Add W32)
[ CmmReg (CmmGlobal PicBaseReg)
, CmmLit $ picRelative
(platformArch $ targetPlatform dflags)
(platformOS $ targetPlatform dflags)
lbl ]
| (gopt Opt_PIC dflags || WayDyn `elem` ways dflags) && absoluteLabel lbl
= CmmMachOp (MO_Add (wordWidth dflags))
[ CmmReg (CmmGlobal PicBaseReg)
, CmmLit $ picRelative
(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
| WayDyn `notElem` ways dflags
= AccessDirectly
| labelDynamic dflags (thisPackage dflags) this_mod lbl
= AccessViaSymbolPtr
| otherwise
= AccessDirectly
howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl
| labelDynamic dflags (thisPackage dflags) this_mod lbl
= AccessViaSymbolPtr
| arch /= ArchX86_64
, gopt Opt_PIC dflags && externallyVisibleCLabel lbl
= AccessViaSymbolPtr
| otherwise
= AccessDirectly
howToAccessLabel dflags arch OSDarwin this_mod JumpReference lbl
| arch == ArchX86 || arch == ArchX86_64
, labelDynamic dflags (thisPackage dflags) this_mod lbl
= AccessViaSymbolPtr
howToAccessLabel dflags arch OSDarwin this_mod _ lbl
| arch /= ArchX86_64
, labelDynamic dflags (thisPackage 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 (gopt Opt_PIC dflags) && WayDyn `notElem` ways dflags
= AccessDirectly
howToAccessLabel dflags arch os this_mod DataReference lbl
| osElfTarget os
= case () of
_ | labelDynamic dflags (thisPackage dflags) this_mod lbl
-> AccessViaSymbolPtr
| arch == ArchPPC
, gopt Opt_PIC dflags
-> AccessViaSymbolPtr
| otherwise
-> AccessDirectly
howToAccessLabel dflags arch os this_mod CallReference lbl
| osElfTarget os
, labelDynamic dflags (thisPackage dflags) this_mod lbl && not (gopt Opt_PIC dflags)
= AccessDirectly
| osElfTarget os
, arch /= ArchX86
, labelDynamic dflags (thisPackage dflags) this_mod lbl && gopt Opt_PIC dflags
= AccessViaStub
howToAccessLabel dflags _ os this_mod _ lbl
| osElfTarget os
= if labelDynamic dflags (thisPackage dflags) this_mod lbl
then AccessViaSymbolPtr
else AccessDirectly
howToAccessLabel dflags _ _ _ _ _
| not (gopt Opt_PIC dflags)
= AccessDirectly
| otherwise
= panic "howToAccessLabel: PIC not defined for this platform"
picRelative :: Arch -> OS -> CLabel -> CmmLit
picRelative arch OSDarwin lbl
| arch /= ArchX86_64
= CmmLabelDiffOff lbl mkPicBaseLabel 0
picRelative _ OSAIX lbl
= CmmLabelDiffOff lbl gotLabel 0
picRelative ArchPPC os lbl
| osElfTarget os
= CmmLabelDiffOff lbl gotLabel 0
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
= gopt Opt_PIC dflags || WayDyn `elem` ways 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
= WayDyn `elem` ways dflags && not (gopt Opt_PIC dflags)
| otherwise
= False
gotLabel :: CLabel
gotLabel
= mkForeignLabel
(fsLit ".LCTOC1")
Nothing ForeignLabelInThisPackage IsData
pprGotDeclaration :: DynFlags -> Arch -> OS -> SDoc
pprGotDeclaration dflags ArchX86 OSDarwin
| gopt Opt_PIC 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 (gopt Opt_PIC 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 gopt Opt_PIC 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 gopt Opt_PIC 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 gopt Opt_PIC 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.ADDI picReg picReg (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"