X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FnativeGen%2FPositionIndependentCode.hs;h=0daccb65309976a2de0743982974cffb99718747;hb=28a464a75e14cece5db40f2765a29348273ff2d2;hp=a6a7b274259553dea27127ebc7ef1235913cc5d0;hpb=70c643c95739f24ead0083ebe4e6a94607bf4e88;p=ghc-hetmet.git diff --git a/ghc/compiler/nativeGen/PositionIndependentCode.hs b/ghc/compiler/nativeGen/PositionIndependentCode.hs index a6a7b27..0daccb6 100644 --- a/ghc/compiler/nativeGen/PositionIndependentCode.hs +++ b/ghc/compiler/nativeGen/PositionIndependentCode.hs @@ -1,5 +1,3 @@ -#include "../includes/ghcconfig.h" - module PositionIndependentCode ( cmmMakeDynamicReference, needImportedSymbols, @@ -20,7 +18,7 @@ module PositionIndependentCode ( CodeStub, SymbolPtr, GotSymbolPtr, GotSymbolOffset - labelDynamic predicate + module Cmm - - The CmmExpr datatype has a CmmPicBaseReg constructor + - The GlobalReg datatype has a PicBaseReg constructor - The CmmLit datatype has a CmmLabelDiffOff constructor + codeGen & RTS - When tablesNextToCode, no absolute addresses are stored in info tables @@ -55,7 +53,7 @@ import CLabel ( CLabel, pprCLabel, dynamicLinkerLabelInfo, mkPicBaseLabel, labelDynamic, externallyVisibleCLabel ) -#if powerpc_TARGET_ARCH && linux_TARGET_OS +#if linux_TARGET_OS import CLabel ( mkForeignLabel ) #endif @@ -63,7 +61,7 @@ import MachRegs import MachInstrs import NCGMonad ( NatM, getNewRegNat, getNewLabelNat ) -import CmdLineOpts ( opt_PIC ) +import StaticFlags ( opt_PIC, opt_Static ) import Pretty import qualified Outputable @@ -127,7 +125,7 @@ cmmMakePicReference :: CLabel -> CmmExpr cmmMakePicReference lbl | opt_PIC && absoluteLabel lbl = CmmMachOp (MO_Add wordRep) [ - CmmPicBaseReg, + CmmReg (CmmGlobal PicBaseReg), CmmLit $ picRelative lbl ] where @@ -172,8 +170,8 @@ howToAccessLabel _ lbl | labelDynamic lbl = AccessViaSymbolPtr -- Mach-O (Darwin, Mac OS X) -- -- Indirect access is required in the following cases: --- * things imported from a dynamic library --- * things from a different module, if we're generating PIC code +-- * things imported from a dynamic library +-- * things from a different module, if we're generating PIC code -- It is always possible to access something indirectly, -- even when it's not necessary. @@ -195,46 +193,30 @@ howToAccessLabel False lbl | opt_PIC && externallyVisibleCLabel lbl = AccessViaSymbolPtr howToAccessLabel _ _ = AccessDirectly -#elif linux_TARGET_OS && powerpc_TARGET_ARCH --- PowerPC Linux --- --- PowerPC Linux is just plain broken. --- While it's theoretically possible to use GOT offsets larger --- than 16 bit, the standard crt*.o files don't, which leads to --- linker errors as soon as the GOT size exceeds 16 bit. --- Also, the assembler doesn't support @gotoff labels. --- In order to be able to use a larger GOT, we circumvent the --- entire GOT mechanism and do it ourselves (this is what GCC does). - --- In this scheme, we need to do _all data references_ (even refs --- to static data) via a SymbolPtr when we are generating PIC. --- Luckily, the PLT works as expected, so we can simply access --- dynamically linked code via the PLT. - -howToAccessLabel _ _ | not opt_PIC = AccessDirectly -howToAccessLabel True lbl - = if labelDynamic lbl then AccessViaStub - else AccessDirectly -howToAccessLabel False lbl - = AccessViaSymbolPtr +#elif linux_TARGET_OS && powerpc64_TARGET_ARCH +-- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC + +howToAccessLabel True lbl = AccessDirectly -- actually, .label instead of label +howToAccessLabel _ lbl = AccessViaSymbolPtr #elif linux_TARGET_OS -- ELF (Linux) -- +-- ELF tries to pretend to the main application code that dynamic linking does +-- not exist. While this may sound convenient, it tends to mess things up in +-- very bad ways, so we have to be careful when we generate code for the main +-- program (-dynamic but no -fPIC). +-- -- Indirect access is required for references to imported symbols --- from position independent code. --- It is always possible to access something indirectly, --- even when it's not necessary. - --- For code, we can use a relative jump to a piece of --- stub code instead (this allows lazy binding of imported symbols). +-- from position independent code. It is also required from the main program +-- when dynamic libraries containing Haskell code are used. howToAccessLabel isJump lbl - -- no PIC -> the dynamic linker does everything for us - | not opt_PIC = AccessDirectly - -- if it's not imported, we need no indirection - -- ("foo" will end up being accessed as "foo@GOTOFF") - | not (labelDynamic lbl) = AccessDirectly + -- no PIC -> the dynamic linker does everything for us; + -- if we don't dynamically link to Haskell code, + -- it actually manages to do so without messing thins up. + | not opt_PIC && opt_Static = AccessDirectly + #if !i386_TARGET_ARCH -- for Intel, we temporarily disable the use of the -- Procedure Linkage Table, because PLTs on intel require the @@ -242,9 +224,35 @@ howToAccessLabel isJump lbl -- a jump through the PLT is made. -- TODO: make the i386 NCG ensure this before jumping to a -- CodeStub label, so we can remove this special case. - | isJump = AccessViaStub + + -- As long as we're in a shared library ourselves, + -- we can use the plt. + -- NOTE: We might want to disable this, because this + -- prevents -fPIC code from being linked statically. + | isJump && labelDynamic lbl && opt_PIC = AccessViaStub + + -- TODO: it would be OK to access non-Haskell code via a stub +-- | isJump && labelDynamic lbl && not isHaskellCode lbl = AccessViaStub + + -- Using code stubs for jumps from the main program to an entry + -- label in a dynamic library is deadly; this will cause the dynamic + -- linker to replace all references (even data references) to that + -- label by references to the stub, so we won't find our info tables + -- any more. +#endif + + -- A dynamic label needs to be accessed via a symbol pointer. + -- NOTE: It would be OK to jump to foreign code via a PLT stub. + | labelDynamic lbl = AccessViaSymbolPtr + +#if powerpc_TARGET_ARCH + -- For PowerPC32 -fPIC, we have to access even static data + -- via a symbol pointer (see below for an explanation why + -- PowerPC32 Linux is especially broken). + | opt_PIC && not isJump = AccessViaSymbolPtr #endif - | otherwise = AccessViaSymbolPtr + + | otherwise = AccessDirectly #else -- @@ -313,12 +321,29 @@ pprCLabel_asm l = asmSDoc (pprCLabel l) needImportedSymbols = True --- We don't need to declare any offset tables +-- We don't need to declare any offset tables. +-- However, for PIC on x86, we need a small helper function. +#if i386_TARGET_ARCH +pprGotDeclaration + | 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") + ] + | otherwise = Pretty.empty +#else pprGotDeclaration = Pretty.empty +#endif -- On Darwin, we have to generate our own stub code for lazy binding.. --- There are two versions, one for PIC and one for non-PIC. +-- For each processor architecture, there are two versions, one for PIC +-- and one for non-PIC. pprImportedSymbol importedLbl +#if powerpc_TARGET_ARCH | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl = case opt_PIC of False -> @@ -361,7 +386,49 @@ pprImportedSymbol importedLbl ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl, ptext SLIT("\t.long dyld_stub_binding_helper") ] - +#elif i386_TARGET_ARCH + | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl + = case opt_PIC of + False -> + vcat [ + ptext SLIT(".symbol_stub"), + ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub:"), + ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl, + ptext SLIT("\tjmp *L") <> pprCLabel_asm lbl + <> ptext SLIT("$lazy_ptr"), + ptext SLIT("L") <> pprCLabel_asm lbl + <> ptext SLIT("$stub_binder:"), + ptext SLIT("\tpushl $L") <> pprCLabel_asm 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 lbl <> ptext SLIT("$stub:"), + ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl, + ptext SLIT("\tcall ___i686.get_pc_thunk.ax"), + ptext SLIT("1:"), + ptext SLIT("\tmovl L") <> pprCLabel_asm lbl + <> ptext SLIT("$lazy_ptr-1b(%eax),%edx"), + ptext SLIT("\tjmp %edx"), + ptext SLIT("L") <> pprCLabel_asm lbl + <> ptext SLIT("$stub_binder:"), + ptext SLIT("\tlea L") <> pprCLabel_asm 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 lbl <> ptext SLIT("$lazy_ptr:"), + ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl, + ptext SLIT("\t.long L") <> pprCLabel_asm lbl + <> ptext SLIT("$stub_binder") + ] +#endif -- We also have to declare our symbol pointers ourselves: | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl = vcat [ @@ -373,27 +440,66 @@ pprImportedSymbol importedLbl | otherwise = empty -#elif powerpc_TARGET_ARCH && linux_TARGET_OS - --- For PowerPC linux, we don't do anything unless we're generating PIC. -needImportedSymbols = opt_PIC +#elif linux_TARGET_OS && !powerpc64_TARGET_ARCH --- If we're generating PIC, we need to create our own "fake GOT". +-- ELF / Linux +-- +-- In theory, we don't need to generate any stubs or symbol pointers +-- by hand for Linux. +-- +-- Reality differs from this in two areas. +-- +-- 1) If we just use a dynamically imported symbol directly in a read-only +-- section of the main executable (as GCC does), ld generates R_*_COPY +-- relocations, which are fundamentally incompatible with reversed info +-- tables. Therefore, we need a table of imported addresses in a writable +-- section. +-- The "official" GOT mechanism (label@got) isn't intended to be used +-- in position dependent code, so we have to create our own "fake GOT" +-- when not opt_PCI && not opt_Static. +-- +-- 2) PowerPC Linux is just plain broken. +-- While it's theoretically possible to use GOT offsets larger +-- than 16 bit, the standard crt*.o files don't, which leads to +-- linker errors as soon as the GOT size exceeds 16 bit. +-- Also, the assembler doesn't support @gotoff labels. +-- In order to be able to use a larger GOT, we have to circumvent the +-- entire GOT mechanism and do it ourselves (this is also what GCC does). + + +-- When needImportedSymbols is defined, +-- the NCG will keep track of all DynamicLinkerLabels it uses +-- and output each of them using pprImportedSymbol. +#if powerpc_TARGET_ARCH + -- PowerPC Linux: -fPIC or -dynamic +needImportedSymbols = opt_PIC || not opt_Static +#else + -- i386 (and others?): -dynamic but not -fPIC +needImportedSymbols = not opt_Static && not opt_PIC +#endif +-- gotLabel +-- The label used to refer to our "fake GOT" from +-- position-independent code. gotLabel = mkForeignLabel -- HACK: it's not really foreign FSLIT(".LCTOC1") Nothing False +-- pprGotDeclaration +-- Output whatever needs to be output once per .s file. -- The .LCTOC1 label is defined to point 32768 bytes into the table, -- to make the most of the PPC's 16-bit displacements. +-- Only needed for PIC. -pprGotDeclaration = vcat [ +pprGotDeclaration + | not opt_PIC = Pretty.empty + | otherwise = vcat [ ptext SLIT(".section \".got2\",\"aw\""), ptext SLIT(".LCTOC1 = .+32768") ] -- We generate one .long literal for every symbol we import; -- the dynamic linker will relocate those addresses. - + pprImportedSymbol importedLbl | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl = vcat [ @@ -428,9 +534,21 @@ pprImportedSymbol _ = empty initializePicBase :: Reg -> [NatCmmTop] -> NatM [NatCmmTop] -#if powerpc_TARGET_ARCH && darwin_TARGET_OS +#if darwin_TARGET_OS -- Darwin is simple: just fetch the address of a local label. +-- The FETCHPC pseudo-instruction is expanded to multiple instructions +-- during pretty-printing so that we don't have to deal with the +-- local label: + +-- PowerPC version: +-- bcl 20,31,1f. +-- 1: mflr picReg + +-- i386 version: +-- call 1f +-- 1: popl %picReg + initializePicBase picReg (CmmProc info lab params blocks : statics) = return (CmmProc info lab params (b':tail blocks) : statics) where BasicBlock bID insns = head blocks @@ -466,23 +584,22 @@ initializePicBase picReg : ADD picReg picReg (RIReg tmp) : insns) return (CmmProc info lab params (b' : tail blocks) : gotOffset : statics) -#else -initializePicBase picReg proc = panic "initializePicBase" +#elif i386_TARGET_ARCH && linux_TARGET_OS --- TODO: --- i386_TARGET_ARCH && linux_TARGET_OS: --- generate something like: +-- We cheat a bit here by defining a pseudo-instruction named FETCHGOT +-- which pretty-prints as: -- call 1f -- 1: popl %picReg -- addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg --- It might be a good idea to use a FETCHPC pseudo-instruction (like for PowerPC) --- in order to avoid having to create a new basic block. --- ((FETCHPC reg) should pretty-print as call 1f; 1: popl reg) +-- (See PprMach.lhs) --- mingw32_TARGET_OS: not needed, won't be called +initializePicBase picReg (CmmProc info lab params blocks : statics) + = return (CmmProc info lab params (b':tail blocks) : statics) + where BasicBlock bID insns = head blocks + b' = BasicBlock bID (FETCHGOT picReg : insns) --- i386_TARGET_ARCH && darwin_TARGET_OS: --- (just for completeness ;-) --- call 1f --- 1: popl %picReg +#else +initializePicBase picReg proc = panic "initializePicBase" + +-- mingw32_TARGET_OS: not needed, won't be called #endif