module PIC (
cmmMakeDynamicReference,
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 Size
import Reg
import NCGMonad
import OldCmm
import CLabel ( CLabel, ForeignLabelSource(..), pprCLabel,
mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..),
dynamicLinkerLabelInfo, mkPicBaseLabel,
labelDynamic, externallyVisibleCLabel )
import CLabel ( mkForeignLabel )
import StaticFlags ( opt_PIC, opt_Static )
import BasicTypes
import Pretty
import qualified Outputable
import Panic ( panic )
import DynFlags
import FastString
data ReferenceKind
= DataReference
| CallReference
| JumpReference
deriving(Eq)
cmmMakeDynamicReference, cmmMakeDynamicReference'
:: Monad m => DynFlags
-> (CLabel -> m ())
-> ReferenceKind
-> CLabel
-> m CmmExpr
cmmMakeDynamicReference = cmmMakeDynamicReference'
cmmMakeDynamicReference' dflags addImport referenceKind lbl
| Just _ <- dynamicLinkerLabelInfo lbl
= return $ CmmLit $ CmmLabel lbl
| otherwise
= case howToAccessLabel
dflags
(platformArch $ targetPlatform dflags)
(platformOS $ targetPlatform dflags)
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
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
| (opt_PIC || not opt_Static) && absoluteLabel lbl
= CmmMachOp (MO_Add wordWidth)
[ 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 -> ReferenceKind -> CLabel -> LabelAccessStyle
howToAccessLabel dflags _ OSMinGW32 _ lbl
| opt_Static
= AccessDirectly
| labelDynamic dflags (thisPackage dflags) lbl
= AccessViaSymbolPtr
| otherwise
= AccessDirectly
howToAccessLabel dflags arch OSDarwin DataReference lbl
| labelDynamic dflags (thisPackage dflags) lbl
= AccessViaSymbolPtr
| arch /= ArchX86_64
, opt_PIC && externallyVisibleCLabel lbl
= AccessViaSymbolPtr
| otherwise
= AccessDirectly
howToAccessLabel dflags arch OSDarwin JumpReference lbl
| arch == ArchX86 || arch == ArchX86_64
, labelDynamic dflags (thisPackage dflags) lbl
= AccessViaSymbolPtr
howToAccessLabel dflags arch OSDarwin _ lbl
| arch /= ArchX86_64
, labelDynamic dflags (thisPackage dflags) lbl
= AccessViaStub
| otherwise
= AccessDirectly
howToAccessLabel _ ArchPPC_64 os kind _
| osElfTarget os
= if kind == DataReference
then AccessViaSymbolPtr
else AccessDirectly
howToAccessLabel _ _ os _ _
| osElfTarget os
, not opt_PIC && opt_Static
= AccessDirectly
howToAccessLabel dflags arch os DataReference lbl
| osElfTarget os
= case () of
_ | labelDynamic dflags (thisPackage dflags) lbl
-> AccessViaSymbolPtr
| arch == ArchPPC
, opt_PIC
-> AccessViaSymbolPtr
| otherwise
-> AccessDirectly
howToAccessLabel dflags arch os CallReference lbl
| osElfTarget os
, labelDynamic dflags (thisPackage dflags) lbl && not opt_PIC
= AccessDirectly
| osElfTarget os
, arch /= ArchX86
, labelDynamic dflags (thisPackage dflags) lbl && opt_PIC
= AccessViaStub
howToAccessLabel dflags _ os _ lbl
| osElfTarget os
= if labelDynamic dflags (thisPackage dflags) lbl
then AccessViaSymbolPtr
else AccessDirectly
howToAccessLabel _ _ _ _ _
| not opt_PIC
= 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 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"
asmSDoc :: Outputable.SDoc -> Doc
asmSDoc d
= Outputable.withPprStyleDoc
(Outputable.mkCodeStyle Outputable.AsmStyle) d
pprCLabel_asm :: Platform -> CLabel -> Doc
pprCLabel_asm platform l
= asmSDoc (pprCLabel platform l)
needImportedSymbols :: Arch -> OS -> Bool
needImportedSymbols arch os
| os == OSDarwin
, arch /= ArchX86_64
= True
| osElfTarget os
, arch == ArchPPC
= opt_PIC || not opt_Static
| osElfTarget os
, arch /= ArchPPC_64
= not opt_Static && not opt_PIC
| otherwise
= False
gotLabel :: CLabel
gotLabel
= mkForeignLabel
(fsLit ".LCTOC1")
Nothing ForeignLabelInThisPackage IsData
pprGotDeclaration :: Arch -> OS -> Doc
pprGotDeclaration ArchX86 OSDarwin
| opt_PIC
= vcat [
ptext (sLit ".section __TEXT,__textcoal_nt,coalesced,no_toc"),
ptext (sLit ".weak_definition ___i686.get_pc_thunk.ax"),
ptext (sLit ".private_extern ___i686.get_pc_thunk.ax"),
ptext (sLit "___i686.get_pc_thunk.ax:"),
ptext (sLit "\tmovl (%esp), %eax"),
ptext (sLit "\tret") ]
pprGotDeclaration _ OSDarwin
= Pretty.empty
pprGotDeclaration arch os
| osElfTarget os
, arch /= ArchPPC_64
, not opt_PIC
= Pretty.empty
| osElfTarget os
, arch /= ArchPPC_64
= vcat [
ptext (sLit ".section \".got2\",\"aw\""),
ptext (sLit ".LCTOC1 = .+32768") ]
pprGotDeclaration _ _
= panic "pprGotDeclaration: no match"
pprImportedSymbol :: Platform -> CLabel -> Doc
pprImportedSymbol platform@(Platform { platformArch = ArchPPC, platformOS = OSDarwin }) importedLbl
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
= case opt_PIC of
False ->
vcat [
ptext (sLit ".symbol_stub"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\tlis r11,ha16(L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr)"),
ptext (sLit "\tlwz r12,lo16(L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr)(r11)"),
ptext (sLit "\tmtctr r12"),
ptext (sLit "\taddi r11,r11,lo16(L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr)"),
ptext (sLit "\tbctr")
]
True ->
vcat [
ptext (sLit ".section __TEXT,__picsymbolstub1,")
<> ptext (sLit "symbol_stubs,pure_instructions,32"),
ptext (sLit "\t.align 2"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\tmflr r0"),
ptext (sLit "\tbcl 20,31,L0$") <> pprCLabel_asm platform lbl,
ptext (sLit "L0$") <> pprCLabel_asm platform lbl <> char ':',
ptext (sLit "\tmflr r11"),
ptext (sLit "\taddis r11,r11,ha16(L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm platform lbl <> char ')',
ptext (sLit "\tmtlr r0"),
ptext (sLit "\tlwzu r12,lo16(L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm platform lbl
<> ptext (sLit ")(r11)"),
ptext (sLit "\tmtctr r12"),
ptext (sLit "\tbctr")
]
$+$ vcat [
ptext (sLit ".lazy_symbol_pointer"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\t.long dyld_stub_binding_helper")]
| Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
= vcat [
ptext (sLit ".non_lazy_symbol_pointer"),
char 'L' <> pprCLabel_asm platform lbl <> ptext (sLit "$non_lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\t.long\t0")]
| otherwise
= empty
pprImportedSymbol platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl
| Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl
= case opt_PIC of
False ->
vcat [
ptext (sLit ".symbol_stub"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\tjmp *L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr"),
ptext (sLit "L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$stub_binder:"),
ptext (sLit "\tpushl $L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr"),
ptext (sLit "\tjmp dyld_stub_binding_helper")
]
True ->
vcat [
ptext (sLit ".section __TEXT,__picsymbolstub2,")
<> ptext (sLit "symbol_stubs,pure_instructions,25"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$stub:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\tcall ___i686.get_pc_thunk.ax"),
ptext (sLit "1:"),
ptext (sLit "\tmovl L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr-1b(%eax),%edx"),
ptext (sLit "\tjmp *%edx"),
ptext (sLit "L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$stub_binder:"),
ptext (sLit "\tlea L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$lazy_ptr-1b(%eax),%eax"),
ptext (sLit "\tpushl %eax"),
ptext (sLit "\tjmp dyld_stub_binding_helper")
]
$+$ vcat [ ptext (sLit ".section __DATA, __la_sym_ptr")
<> (if opt_PIC then int 2 else int 3)
<> ptext (sLit ",lazy_symbol_pointers"),
ptext (sLit "L") <> pprCLabel_asm platform lbl <> ptext (sLit "$lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\t.long L") <> pprCLabel_asm platform lbl
<> ptext (sLit "$stub_binder")]
| Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl
= vcat [
ptext (sLit ".non_lazy_symbol_pointer"),
char 'L' <> pprCLabel_asm platform lbl <> ptext (sLit "$non_lazy_ptr:"),
ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm platform lbl,
ptext (sLit "\t.long\t0")]
| otherwise
= empty
pprImportedSymbol (Platform { platformOS = OSDarwin }) _
= empty
pprImportedSymbol platform@(Platform { platformArch = ArchPPC_64 }) _
| osElfTarget (platformOS platform)
= empty
pprImportedSymbol platform importedLbl
| osElfTarget (platformOS platform)
= case dynamicLinkerLabelInfo importedLbl of
Just (SymbolPtr, lbl)
-> let symbolSize = case wordWidth of
W32 -> sLit "\t.long"
W64 -> sLit "\t.quad"
_ -> panic "Unknown wordRep in pprImportedSymbol"
in vcat [
ptext (sLit ".section \".got2\", \"aw\""),
ptext (sLit ".LC_") <> pprCLabel_asm platform lbl <> char ':',
ptext symbolSize <+> pprCLabel_asm 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 (ListGraph blocks) : statics)
| osElfTarget os
= do
gotOffLabel <- getNewLabelNat
tmp <- getNewRegNat $ intSize wordWidth
let
gotOffset = CmmData Text $ Statics gotOffLabel [
CmmStaticLit (CmmLabelDiffOff gotLabel
mkPicBaseLabel
0)
]
offsetToOffset
= PPC.ImmConstantDiff
(PPC.ImmCLbl gotOffLabel)
(PPC.ImmCLbl mkPicBaseLabel)
BasicBlock bID insns
= head blocks
b' = BasicBlock bID (PPC.FETCHPC picReg
: PPC.LD PPC.archWordSize tmp
(PPC.AddrRegImm picReg offsetToOffset)
: PPC.ADD picReg picReg (PPC.RIReg tmp)
: insns)
return (CmmProc info lab (ListGraph (b' : tail blocks)) : gotOffset : statics)
initializePicBase_ppc ArchPPC OSDarwin picReg
(CmmProc info lab (ListGraph blocks) : statics)
= return (CmmProc info lab (ListGraph (b':tail blocks)) : statics)
where BasicBlock bID insns = head blocks
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 (ListGraph blocks) : statics)
| osElfTarget os
= return (CmmProc info lab (ListGraph (b':tail blocks)) : statics)
where BasicBlock bID insns = head blocks
b' = BasicBlock bID (X86.FETCHGOT picReg : insns)
initializePicBase_x86 ArchX86 OSDarwin picReg
(CmmProc info lab (ListGraph blocks) : statics)
= return (CmmProc info lab (ListGraph (b':tail blocks)) : statics)
where BasicBlock bID insns = head blocks
b' = BasicBlock bID (X86.FETCHPC picReg : insns)
initializePicBase_x86 _ _ _ _
= panic "initializePicBase_x86: not needed"