X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FPositionIndependentCode.hs;h=7d13f114e270f39a5edb3cfe39de503316bf9fca;hb=97169c5dd31537b28f5f8ad08cd6cdf82c1ecefd;hp=523f305a6264a92bfaa8b1c2190d1cd5e27d3de5;hpb=28c556a5e0ed5c2687f19ec6ef8853b79ad65518;p=ghc-hetmet.git diff --git a/compiler/nativeGen/PositionIndependentCode.hs b/compiler/nativeGen/PositionIndependentCode.hs index 523f305..7d13f11 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(..), @@ -48,7 +55,7 @@ module PositionIndependentCode ( #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 +75,7 @@ import Pretty import qualified Outputable import Panic ( panic ) +import DynFlags -- The most important function here is cmmMakeDynamicReference. @@ -90,16 +98,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 @@ -131,7 +140,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 ] @@ -161,7 +170,7 @@ data LabelAccessStyle = AccessViaStub | AccessViaSymbolPtr | AccessDirectly -howToAccessLabel :: ReferenceKind -> CLabel -> LabelAccessStyle +howToAccessLabel :: DynFlags -> ReferenceKind -> CLabel -> LabelAccessStyle #if mingw32_TARGET_OS -- Windows @@ -170,8 +179,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 +190,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 @@ -200,21 +209,21 @@ howToAccessLabel DataReference lbl | otherwise = AccessDirectly -#if x86_TARGET_ARCH || x86_64_TARGET_ARCH +#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 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 +233,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 +248,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 +278,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 CallLabel 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 - = AccessViaSymbolStub + | 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 @@ -372,6 +381,9 @@ 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 @@ -442,7 +454,7 @@ pprImportedSymbol importedLbl ptext SLIT("1:"), ptext SLIT("\tmovl L") <> pprCLabel_asm lbl <> ptext SLIT("$lazy_ptr-1b(%eax),%edx"), - ptext SLIT("\tjmp %edx"), + ptext SLIT("\tjmp *%edx"), ptext SLIT("L") <> pprCLabel_asm lbl <> ptext SLIT("$stub_binder:"), ptext SLIT("\tlea L") <> pprCLabel_asm lbl @@ -527,7 +539,7 @@ pprGotDeclaration 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 @@ -535,11 +547,16 @@ pprImportedSymbol importedLbl = vcat [ ptext SLIT(".section \".got2\", \"aw\""), ptext SLIT(".LC_") <> pprCLabel_asm lbl <> char ':', - ptext SLIT("\t.long") <+> pprCLabel_asm lbl + 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 +596,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 +611,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 +630,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 +640,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)