X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FPositionIndependentCode.hs;h=0473d91da206cff32b84f8c901ebb7943402c192;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=4001078df1f29c100bb05df9910f5e29495949be;hpb=c111317d3209321e5f2ba43304018b132b174415;p=ghc-hetmet.git diff --git a/compiler/nativeGen/PositionIndependentCode.hs b/compiler/nativeGen/PositionIndependentCode.hs index 4001078..0473d91 100644 --- a/compiler/nativeGen/PositionIndependentCode.hs +++ b/compiler/nativeGen/PositionIndependentCode.hs @@ -1,3 +1,10 @@ +{-# OPTIONS -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings +-- for details + module PositionIndependentCode ( cmmMakeDynamicReference, ReferenceKind(..), @@ -7,6 +14,8 @@ module PositionIndependentCode ( initializePicBase ) where +#include "HsVersions.h" + {- This module handles generation of position independent code and dynamic-linking related issues for the native code generator. @@ -43,12 +52,11 @@ module PositionIndependentCode ( by GCC are left intact by the mangler (so far only on ppc-darwin and ppc-linux). -} - -#include "HsVersions.h" + #include "nativeGen/NCG.h" import Cmm -import MachOp ( MachOp(MO_Add), wordRep ) +import MachOp ( MachOp(MO_Add), wordRep, MachRep(..) ) import CLabel ( CLabel, pprCLabel, mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..), dynamicLinkerLabelInfo, mkPicBaseLabel, @@ -68,6 +76,8 @@ import Pretty import qualified Outputable import Panic ( panic ) +import DynFlags +import FastString -- The most important function here is cmmMakeDynamicReference. @@ -90,16 +100,17 @@ data ReferenceKind = DataReference deriving(Eq) cmmMakeDynamicReference - :: Monad m => (CLabel -> m ()) -- a monad & a function + :: Monad m => DynFlags + -> (CLabel -> m ()) -- a monad & a function -- used for recording imported symbols -> ReferenceKind -- whether this is the target of a jump -> CLabel -- the label -> m CmmExpr -cmmMakeDynamicReference addImport referenceKind lbl +cmmMakeDynamicReference dflags addImport referenceKind lbl | Just _ <- dynamicLinkerLabelInfo lbl = return $ CmmLit $ CmmLabel lbl -- already processed it, pass through - | otherwise = case howToAccessLabel referenceKind lbl of + | otherwise = case howToAccessLabel dflags referenceKind lbl of AccessViaStub -> do let stub = mkDynamicLinkerLabel CodeStub lbl addImport stub @@ -161,7 +172,7 @@ data LabelAccessStyle = AccessViaStub | AccessViaSymbolPtr | AccessDirectly -howToAccessLabel :: ReferenceKind -> CLabel -> LabelAccessStyle +howToAccessLabel :: DynFlags -> ReferenceKind -> CLabel -> LabelAccessStyle #if mingw32_TARGET_OS -- Windows @@ -170,8 +181,8 @@ howToAccessLabel :: ReferenceKind -> CLabel -> LabelAccessStyle -- are imported from a DLL via an __imp_* label. -- There are no stubs for imported code. -howToAccessLabel _ lbl | labelDynamic lbl = AccessViaSymbolPtr - | otherwise = AccessDirectly +howToAccessLabel dflags _ lbl | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr + | otherwise = AccessDirectly #elif darwin_TARGET_OS -- Mach-O (Darwin, Mac OS X) -- @@ -181,9 +192,9 @@ howToAccessLabel _ lbl | labelDynamic lbl = AccessViaSymbolPtr -- It is always possible to access something indirectly, -- even when it's not necessary. -howToAccessLabel DataReference lbl +howToAccessLabel dflags DataReference lbl -- data access to a dynamic library goes via a symbol pointer - | labelDynamic lbl = AccessViaSymbolPtr + | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr #if !x86_64_TARGET_ARCH -- when generating PIC code, all cross-module data references must @@ -204,17 +215,17 @@ howToAccessLabel DataReference lbl -- dyld code stubs don't work for tailcalls because the -- stack alignment is only right for regular calls. -- Therefore, we have to go via a symbol pointer: -howToAccessLabel JumpReference lbl - | labelDynamic lbl +howToAccessLabel dflags JumpReference lbl + | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr #endif -howToAccessLabel _ lbl +howToAccessLabel dflags _ lbl #if !x86_64_TARGET_ARCH -- Code stubs are the usual method of choice for imported code; -- not needed on x86_64 because Apple's new linker, ld64, generates -- them automatically. - | labelDynamic lbl + | labelDynamic (thisPackage dflags) lbl = AccessViaStub #endif | otherwise @@ -224,8 +235,8 @@ howToAccessLabel _ lbl #elif linux_TARGET_OS && powerpc64_TARGET_ARCH -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC -howToAccessLabel DataReference lbl = AccessViaSymbolPtr -howToAccessLabel _ lbl = AccessDirectly -- actually, .label instead of label +howToAccessLabel _ DataReference lbl = AccessViaSymbolPtr +howToAccessLabel _ _ lbl = AccessDirectly -- actually, .label instead of label #elif linux_TARGET_OS -- ELF (Linux) @@ -239,15 +250,15 @@ howToAccessLabel _ lbl = AccessDirectly -- actually, .label instead of label -- from position independent code. It is also required from the main program -- when dynamic libraries containing Haskell code are used. -howToAccessLabel _ lbl +howToAccessLabel _ _ lbl -- 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 -howToAccessLabel DataReference lbl +howToAccessLabel dflags DataReference lbl -- A dynamic label needs to be accessed via a symbol pointer. - | labelDynamic lbl = AccessViaSymbolPtr + | labelDynamic (thisPackage dflags) 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 @@ -269,22 +280,22 @@ howToAccessLabel DataReference lbl -- (AccessDirectly, because we get an implicit symbol stub) -- and calling functions from PIC code on non-i386 platforms (via a symbol stub) -howToAccessLabel CallReference lbl - | labelDynamic lbl && not opt_PIC +howToAccessLabel dflags CallReference lbl + | labelDynamic (thisPackage dflags) lbl && not opt_PIC = AccessDirectly #if !i386_TARGET_ARCH - | labelDynamic lbl && opt_PIC + | labelDynamic (thisPackage dflags) lbl && opt_PIC = AccessViaStub #endif -howToAccessLabel _ lbl - | labelDynamic lbl = AccessViaSymbolPtr +howToAccessLabel dflags _ lbl + | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr | otherwise = AccessDirectly #else -- -- all other platforms -- -howToAccessLabel _ _ +howToAccessLabel _ _ _ | not opt_PIC = AccessDirectly | otherwise = panic "howToAccessLabel: PIC not defined for this platform" #endif @@ -357,12 +368,12 @@ needImportedSymbols = True 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") + 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 @@ -372,100 +383,103 @@ pprGotDeclaration = Pretty.empty -- On Darwin, we have to generate our own stub code for lazy binding.. -- For each processor architecture, there are two versions, one for PIC -- and one for non-PIC. +-- +-- Whenever you change something in this assembler output, make sure +-- the splitter in driver/split/ghc-split.lprl recognizes the new output pprImportedSymbol importedLbl #if powerpc_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("\tlis r11,ha16(L") <> pprCLabel_asm lbl - <> ptext SLIT("$lazy_ptr)"), - ptext SLIT("\tlwz r12,lo16(L") <> pprCLabel_asm lbl - <> ptext SLIT("$lazy_ptr)(r11)"), - ptext SLIT("\tmtctr r12"), - ptext SLIT("\taddi r11,r11,lo16(L") <> pprCLabel_asm lbl - <> ptext SLIT("$lazy_ptr)"), - ptext SLIT("\tbctr") + ptext (sLit ".symbol_stub"), + ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"), + ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl, + ptext (sLit "\tlis r11,ha16(L") <> pprCLabel_asm lbl + <> ptext (sLit "$lazy_ptr)"), + ptext (sLit "\tlwz r12,lo16(L") <> pprCLabel_asm lbl + <> ptext (sLit "$lazy_ptr)(r11)"), + ptext (sLit "\tmtctr r12"), + ptext (sLit "\taddi r11,r11,lo16(L") <> pprCLabel_asm 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 lbl <> ptext SLIT("$stub:"), - ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl, - ptext SLIT("\tmflr r0"), - ptext SLIT("\tbcl 20,31,L0$") <> pprCLabel_asm lbl, - ptext SLIT("L0$") <> pprCLabel_asm lbl <> char ':', - ptext SLIT("\tmflr r11"), - ptext SLIT("\taddis r11,r11,ha16(L") <> pprCLabel_asm lbl - <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl <> char ')', - ptext SLIT("\tmtlr r0"), - ptext SLIT("\tlwzu r12,lo16(L") <> pprCLabel_asm lbl - <> ptext SLIT("$lazy_ptr-L0$") <> pprCLabel_asm lbl - <> ptext SLIT(")(r11)"), - ptext SLIT("\tmtctr r12"), - ptext SLIT("\tbctr") + ptext (sLit ".section __TEXT,__picsymbolstub1,") + <> ptext (sLit "symbol_stubs,pure_instructions,32"), + ptext (sLit "\t.align 2"), + ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$stub:"), + ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl, + ptext (sLit "\tmflr r0"), + ptext (sLit "\tbcl 20,31,L0$") <> pprCLabel_asm lbl, + ptext (sLit "L0$") <> pprCLabel_asm lbl <> char ':', + ptext (sLit "\tmflr r11"), + ptext (sLit "\taddis r11,r11,ha16(L") <> pprCLabel_asm lbl + <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm lbl <> char ')', + ptext (sLit "\tmtlr r0"), + ptext (sLit "\tlwzu r12,lo16(L") <> pprCLabel_asm lbl + <> ptext (sLit "$lazy_ptr-L0$") <> pprCLabel_asm lbl + <> ptext (sLit ")(r11)"), + ptext (sLit "\tmtctr r12"), + ptext (sLit "\tbctr") ] $+$ vcat [ - ptext SLIT(".lazy_symbol_pointer"), - ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr:"), - ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl, - ptext SLIT("\t.long dyld_stub_binding_helper") + ptext (sLit ".lazy_symbol_pointer"), + ptext (sLit "L") <> pprCLabel_asm lbl <> ptext (sLit "$lazy_ptr:"), + 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") + 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") + 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") + $+$ 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") + <> 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 [ - ptext SLIT(".non_lazy_symbol_pointer"), - char 'L' <> pprCLabel_asm lbl <> ptext SLIT("$non_lazy_ptr:"), - ptext SLIT("\t.indirect_symbol") <+> pprCLabel_asm lbl, - ptext SLIT("\t.long\t0") + ptext (sLit ".non_lazy_symbol_pointer"), + char 'L' <> pprCLabel_asm lbl <> ptext (sLit "$non_lazy_ptr:"), + ptext (sLit "\t.indirect_symbol") <+> pprCLabel_asm lbl, + ptext (sLit "\t.long\t0") ] | otherwise = empty @@ -512,7 +526,7 @@ needImportedSymbols = not opt_Static && not opt_PIC -- 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 + (fsLit ".LCTOC1") Nothing False -- pprGotDeclaration -- Output whatever needs to be output once per .s file. @@ -523,23 +537,28 @@ gotLabel = mkForeignLabel -- HACK: it's not really foreign pprGotDeclaration | not opt_PIC = Pretty.empty | otherwise = vcat [ - ptext SLIT(".section \".got2\",\"aw\""), - ptext SLIT(".LCTOC1 = .+32768") + ptext (sLit ".section \".got2\",\"aw\""), + ptext (sLit ".LCTOC1 = .+32768") ] --- We generate one .long literal for every symbol we import; +-- We generate one .long/.quad literal for every symbol we import; -- the dynamic linker will relocate those addresses. pprImportedSymbol importedLbl | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl = vcat [ - ptext SLIT(".section \".got2\", \"aw\""), - ptext SLIT(".LC_") <> pprCLabel_asm lbl <> char ':', - ptext SLIT("\t.long") <+> pprCLabel_asm lbl + ptext (sLit ".section \".got2\", \"aw\""), + ptext (sLit ".LC_") <> pprCLabel_asm lbl <> char ':', + ptext symbolSize <+> pprCLabel_asm lbl ] -- PLT code stubs are generated automatically be the dynamic linker. | otherwise = empty + where + symbolSize = case wordRep of + I32 -> sLit "\t.long" + I64 -> sLit "\t.quad" + _ -> panic "Unknown wordRep in pprImportedSymbol" #else @@ -579,8 +598,8 @@ initializePicBase :: Reg -> [NatCmmTop] -> NatM [NatCmmTop] -- call 1f -- 1: popl %picReg -initializePicBase picReg (CmmProc info lab params blocks : statics) - = return (CmmProc info lab params (b':tail blocks) : statics) +initializePicBase picReg (CmmProc info lab params (ListGraph blocks) : statics) + = return (CmmProc info lab params (ListGraph (b':tail blocks)) : statics) where BasicBlock bID insns = head blocks b' = BasicBlock bID (FETCHPC picReg : insns) @@ -594,7 +613,7 @@ initializePicBase picReg (CmmProc info lab params blocks : statics) -- the (32-bit) offset from our local label to our global offset table -- (.LCTOC1 aka gotOffLabel). initializePicBase picReg - (CmmProc info lab params blocks : statics) + (CmmProc info lab params (ListGraph blocks) : statics) = do gotOffLabel <- getNewLabelNat tmp <- getNewRegNat wordRep @@ -613,7 +632,7 @@ initializePicBase picReg (AddrRegImm picReg offsetToOffset) : ADD picReg picReg (RIReg tmp) : insns) - return (CmmProc info lab params (b' : tail blocks) : gotOffset : statics) + return (CmmProc info lab params (ListGraph (b' : tail blocks)) : gotOffset : statics) #elif i386_TARGET_ARCH && linux_TARGET_OS -- We cheat a bit here by defining a pseudo-instruction named FETCHGOT @@ -623,8 +642,8 @@ initializePicBase picReg -- addl __GLOBAL_OFFSET_TABLE__+.-1b, %picReg -- (See PprMach.lhs) -initializePicBase picReg (CmmProc info lab params blocks : statics) - = return (CmmProc info lab params (b':tail blocks) : statics) +initializePicBase picReg (CmmProc info lab params (ListGraph blocks) : statics) + = return (CmmProc info lab params (ListGraph (b':tail blocks)) : statics) where BasicBlock bID insns = head blocks b' = BasicBlock bID (FETCHGOT picReg : insns)