X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FnativeGen%2FPositionIndependentCode.hs;h=7d13f114e270f39a5edb3cfe39de503316bf9fca;hb=6a05ec5ef5373f61b7f9f5bdc344483417fa801b;hp=6a94de22b2251ad597b6c21b44aa8973caa00964;hpb=ee40dd6ba3e4effa2cf6c6f06dc2b7477fc55f18;p=ghc-hetmet.git diff --git a/compiler/nativeGen/PositionIndependentCode.hs b/compiler/nativeGen/PositionIndependentCode.hs index 6a94de2..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 @@ -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 @@ -204,17 +213,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 +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 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 @@ -530,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 @@ -538,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 @@ -582,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) @@ -597,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 @@ -616,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 @@ -626,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)