X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FPositionIndependentCode.hs;h=0473d91da206cff32b84f8c901ebb7943402c192;hb=08652e67c4d5d9a40687f93c286021a867c1bca0;hp=ffd65773c7c79fe1ea5930841b4aecd818f633de;hpb=5cfeedcc9f3ad65283d98063f0b228edca9990b2;p=ghc-hetmet.git diff --git a/compiler/nativeGen/PositionIndependentCode.hs b/compiler/nativeGen/PositionIndependentCode.hs index ffd6577..0473d91 100644 --- a/compiler/nativeGen/PositionIndependentCode.hs +++ b/compiler/nativeGen/PositionIndependentCode.hs @@ -1,11 +1,21 @@ +{-# 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(..), needImportedSymbols, pprImportedSymbol, pprGotDeclaration, initializePicBase ) where +#include "HsVersions.h" + {- This module handles generation of position independent code and dynamic-linking related issues for the native code generator. @@ -42,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, @@ -67,6 +76,8 @@ import Pretty import qualified Outputable import Panic ( panic ) +import DynFlags +import FastString -- The most important function here is cmmMakeDynamicReference. @@ -83,17 +94,23 @@ import Panic ( panic ) -- - addImportCmmOpt for the CmmOptM monad -- - addImportNat for the NatM monad. +data ReferenceKind = DataReference + | CallReference + | JumpReference + 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 - -> Bool -- whether this is the target of a jump + -> ReferenceKind -- whether this is the target of a jump -> CLabel -- the label -> m CmmExpr -cmmMakeDynamicReference addImport isJumpTarget lbl +cmmMakeDynamicReference dflags addImport referenceKind lbl | Just _ <- dynamicLinkerLabelInfo lbl = return $ CmmLit $ CmmLabel lbl -- already processed it, pass through - | otherwise = case howToAccessLabel isJumpTarget lbl of + | otherwise = case howToAccessLabel dflags referenceKind lbl of AccessViaStub -> do let stub = mkDynamicLinkerLabel CodeStub lbl addImport stub @@ -102,12 +119,13 @@ cmmMakeDynamicReference addImport isJumpTarget lbl let symbolPtr = mkDynamicLinkerLabel SymbolPtr lbl addImport symbolPtr return $ CmmLoad (cmmMakePicReference symbolPtr) wordRep - AccessDirectly - -- all currently supported processors support - -- a PC-relative branch instruction, so just jump there - | isJumpTarget -> return $ CmmLit $ CmmLabel lbl + AccessDirectly -> case referenceKind of -- for data, we might have to make some calculations: - | otherwise -> return $ cmmMakePicReference lbl + DataReference -> return $ cmmMakePicReference lbl + -- all currently supported processors support + -- PC-relative branch and call instructions, + -- so just jump there if it's a call or a jump + _ -> return $ CmmLit $ CmmLabel lbl -- ------------------------------------------------------------------- @@ -124,7 +142,7 @@ cmmMakePicReference :: CLabel -> CmmExpr -- everything gets relocated at runtime cmmMakePicReference lbl - | opt_PIC && absoluteLabel lbl = CmmMachOp (MO_Add wordRep) [ + | (opt_PIC || not opt_Static) && absoluteLabel lbl = CmmMachOp (MO_Add wordRep) [ CmmReg (CmmGlobal PicBaseReg), CmmLit $ picRelative lbl ] @@ -154,7 +172,7 @@ data LabelAccessStyle = AccessViaStub | AccessViaSymbolPtr | AccessDirectly -howToAccessLabel :: Bool -> CLabel -> LabelAccessStyle +howToAccessLabel :: DynFlags -> ReferenceKind -> CLabel -> LabelAccessStyle #if mingw32_TARGET_OS -- Windows @@ -163,47 +181,62 @@ howToAccessLabel :: Bool -> 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) -- -- 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 +-- * (not on x86_64) data from a different module, if we're generating PIC code -- It is always possible to access something indirectly, -- even when it's not necessary. -#if powerpc_TARGET_ARCH || powerpc64_TARGET_ARCH - -- on i386 and probably also on x86_64, dyld code stubs don't - -- work for tailcalls because the stack alignment is only right - -- for regular calls. - -howToAccessLabel True lbl - -- jumps to a dynamic library go via a symbol stub - | labelDynamic lbl = AccessViaStub - -- when generating PIC code, all cross-module references must - -- must go via a symbol pointer, too. +howToAccessLabel dflags DataReference lbl + -- data access to a dynamic library goes via a symbol pointer + | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr + +#if !x86_64_TARGET_ARCH + -- when generating PIC code, all cross-module data references must + -- must go via a symbol pointer, too, because the assembler + -- cannot generate code for a label difference where one + -- label is undefined. Doesn't apply t x86_64. -- Unfortunately, we don't know whether it's cross-module, -- so we do it for all externally visible labels. -- This is a slight waste of time and space, but otherwise -- we'd need to pass the current Module all the way in to -- this function. - | opt_PIC && externallyVisibleCLabel lbl = AccessViaStub -#endif -howToAccessLabel _ lbl - -- data access to a dynamic library goes via a symbol pointer - | labelDynamic lbl = AccessViaSymbolPtr - -- cross-module PIC references: same as above | opt_PIC && externallyVisibleCLabel lbl = AccessViaSymbolPtr -howToAccessLabel _ _ = AccessDirectly +#endif + | otherwise = AccessDirectly + + +#if i386_TARGET_ARCH || x86_64_TARGET_ARCH + -- 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 dflags JumpReference lbl + | labelDynamic (thisPackage dflags) lbl + = AccessViaSymbolPtr +#endif + +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 (thisPackage dflags) lbl + = AccessViaStub +#endif + | otherwise + = AccessDirectly + #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 +howToAccessLabel _ DataReference lbl = AccessViaSymbolPtr +howToAccessLabel _ _ lbl = AccessDirectly -- actually, .label instead of label #elif linux_TARGET_OS -- ELF (Linux) @@ -217,54 +250,52 @@ howToAccessLabel _ lbl = AccessViaSymbolPtr -- from position independent code. It is also required from the main program -- when dynamic libraries containing Haskell code are used. -howToAccessLabel isJump 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 -#if !i386_TARGET_ARCH --- for Intel, we temporarily disable the use of the --- Procedure Linkage Table, because PLTs on intel require the --- address of the GOT to be loaded into register %ebx before --- 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. - - -- 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 - +howToAccessLabel dflags DataReference lbl -- 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 - + | 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 -- PowerPC32 Linux is especially broken). - | opt_PIC && not isJump = AccessViaSymbolPtr + | opt_PIC = AccessViaSymbolPtr #endif - | otherwise = AccessDirectly + +-- In most cases, we have to avoid symbol stubs on ELF, for the following reasons: +-- * on i386, the position-independent symbol stubs in the Procedure Linkage Table +-- require the address of the GOT to be loaded into register %ebx on entry. +-- * The linker will take any reference to the symbol stub as a hint that +-- the label in question is a code label. When linking executables, this +-- will cause the linker to replace even data references to the label with +-- references to the symbol stub. + +-- This leaves calling a (foreign) function from non-PIC code +-- (AccessDirectly, because we get an implicit symbol stub) +-- and calling functions from PIC code on non-i386 platforms (via a symbol stub) + +howToAccessLabel dflags CallReference lbl + | labelDynamic (thisPackage dflags) lbl && not opt_PIC + = AccessDirectly +#if !i386_TARGET_ARCH + | labelDynamic (thisPackage dflags) lbl && opt_PIC + = AccessViaStub +#endif + +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 @@ -275,8 +306,8 @@ howToAccessLabel _ _ -- get the address of a label? picRelative :: CLabel -> CmmLit -#if darwin_TARGET_OS --- Darwin: +#if darwin_TARGET_OS && !x86_64_TARGET_ARCH +-- Darwin, but not x86_64: -- The PIC base register points to the PIC base label at the beginning -- of the current CmmTop. We just have to use a label difference to -- get the offset. @@ -297,10 +328,14 @@ picRelative lbl picRelative lbl = CmmLabelDiffOff lbl gotLabel 0 -#elif linux_TARGET_OS --- Other Linux versions: +#elif linux_TARGET_OS || (darwin_TARGET_OS && x86_64_TARGET_ARCH) +-- Most Linux versions: -- The PIC base register points to the GOT. Use foo@got for symbol -- pointers, and foo@gotoff for everything else. +-- Linux and Darwin on x86_64: +-- The PIC base register is %rip, we use foo@gotpcrel for symbol pointers, +-- and a GotSymbolOffset label for other things. +-- For reasons of tradition, the symbol offset label is written as a plain label. picRelative lbl | Just (SymbolPtr, lbl') <- dynamicLinkerLabelInfo lbl @@ -323,7 +358,7 @@ asmSDoc d = Outputable.withPprStyleDoc ( pprCLabel_asm l = asmSDoc (pprCLabel l) -#if darwin_TARGET_OS +#if darwin_TARGET_OS && !x86_64_TARGET_ARCH needImportedSymbols = True @@ -333,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 @@ -348,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 @@ -488,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. @@ -499,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 @@ -555,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) @@ -570,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 @@ -589,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 @@ -599,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)