X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FnativeGen%2FPIC.hs;h=c375ab4707f9f6a01728a38a4a13819e63f31864;hp=74c8bb3fce43a20c1457c719b28c8c4b2b513e26;hb=c5b178be60a5a44abd2f4ddf8c399857678326e2;hpb=3d52165d6ff86168fd68addd56be0eb1893aaa1f diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs index 74c8bb3..c375ab4 100644 --- a/compiler/nativeGen/PIC.hs +++ b/compiler/nativeGen/PIC.hs @@ -63,8 +63,8 @@ import Reg import NCGMonad -import Cmm -import CLabel ( CLabel, pprCLabel, +import OldCmm +import CLabel ( CLabel, ForeignLabelSource(..), pprCLabel, mkDynamicLinkerLabel, DynamicLinkerLabelInfo(..), dynamicLinkerLabelInfo, mkPicBaseLabel, labelDynamic, externallyVisibleCLabel ) @@ -83,6 +83,7 @@ import DynFlags import FastString + -------------------------------------------------------------------------------- -- It gets called by the cmmToCmm pass for every CmmLabel in the Cmm -- code. It does The Right Thing(tm) to convert the CmmLabel into a @@ -103,15 +104,17 @@ data ReferenceKind deriving(Eq) -cmmMakeDynamicReference +cmmMakeDynamicReference, cmmMakeDynamicReference' :: 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 = cmmMakeDynamicReference' -cmmMakeDynamicReference dflags addImport referenceKind lbl +cmmMakeDynamicReference' dflags addImport referenceKind lbl | Just _ <- dynamicLinkerLabelInfo lbl = return $ CmmLit $ CmmLabel lbl -- already processed it, pass through @@ -192,16 +195,40 @@ data LabelAccessStyle howToAccessLabel :: DynFlags -> Arch -> OS -> ReferenceKind -> CLabel -> LabelAccessStyle + -- Windows --- --- We need to use access *exactly* those things that --- are imported from a DLL via an __imp_* label. --- There are no stubs for imported code. +-- In Windows speak, a "module" is a set of objects linked into the +-- same Portable Exectuable (PE) file. (both .exe and .dll files are PEs). +-- +-- If we're compiling a multi-module program then symbols from other modules +-- are accessed by a symbol pointer named __imp_SYMBOL. At runtime we have the +-- following. +-- +-- (in the local module) +-- __imp_SYMBOL: addr of SYMBOL +-- +-- (in the other module) +-- SYMBOL: the real function / data. +-- +-- To access the function at SYMBOL from our local module, we just need to +-- dereference the local __imp_SYMBOL. +-- +-- If opt_Static is set then we assume that all our code will be linked +-- into the same .exe file. In this case we always access symbols directly, +-- and never use __imp_SYMBOL. -- howToAccessLabel dflags _ OSMinGW32 _ lbl + + -- Assume all symbols will be in the same PE, so just access them directly. + | opt_Static + = AccessDirectly + + -- If the target symbol is in another PE we need to access it via the + -- appropriate __imp_SYMBOL pointer. | labelDynamic (thisPackage dflags) lbl = AccessViaSymbolPtr + -- Target symbol is in the same PE as the caller, so just access it directly. | otherwise = AccessDirectly @@ -266,37 +293,38 @@ howToAccessLabel dflags arch OSDarwin _ lbl -- from position independent code. It is also required from the main program -- when dynamic libraries containing Haskell code are used. -howToAccessLabel _ ArchPPC_64 OSLinux kind _ - - -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC - | DataReference <- kind - = AccessViaSymbolPtr - - -- actually, .label instead of label - | otherwise - = AccessDirectly +howToAccessLabel _ ArchPPC_64 os kind _ + | osElfTarget os + = if kind == DataReference + -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC + then AccessViaSymbolPtr + -- actually, .label instead of label + else AccessDirectly -howToAccessLabel _ _ OSLinux _ _ +howToAccessLabel _ _ os _ _ -- 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 + | osElfTarget os + , not opt_PIC && opt_Static = AccessDirectly -howToAccessLabel dflags arch OSLinux DataReference lbl - -- A dynamic label needs to be accessed via a symbol pointer. - | labelDynamic (thisPackage dflags) lbl - = AccessViaSymbolPtr - - -- 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). - | arch == ArchPPC - , opt_PIC - = AccessViaSymbolPtr +howToAccessLabel dflags arch os DataReference lbl + | osElfTarget os + = case () of + -- A dynamic label needs to be accessed via a symbol pointer. + _ | labelDynamic (thisPackage dflags) lbl + -> AccessViaSymbolPtr + + -- 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). + | arch == ArchPPC + , opt_PIC + -> AccessViaSymbolPtr - | otherwise - = AccessDirectly + | otherwise + -> AccessDirectly -- In most cases, we have to avoid symbol stubs on ELF, for the following reasons: @@ -311,20 +339,21 @@ howToAccessLabel dflags arch OSLinux 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 dflags arch OSLinux CallReference lbl - | labelDynamic (thisPackage dflags) lbl && not opt_PIC +howToAccessLabel dflags arch os CallReference lbl + | osElfTarget os + , labelDynamic (thisPackage dflags) lbl && not opt_PIC = AccessDirectly - | arch /= ArchX86 + | osElfTarget os + , arch /= ArchX86 , labelDynamic (thisPackage dflags) lbl && opt_PIC = AccessViaStub -howToAccessLabel dflags _ OSLinux _ lbl - | labelDynamic (thisPackage dflags) lbl - = AccessViaSymbolPtr - - | otherwise - = AccessDirectly +howToAccessLabel dflags _ os _ lbl + | osElfTarget os + = if labelDynamic (thisPackage dflags) lbl + then AccessViaSymbolPtr + else AccessDirectly -- all other platforms howToAccessLabel _ _ _ _ _ @@ -360,7 +389,8 @@ picRelative arch OSDarwin lbl -- We have made sure that *everything* is accessed indirectly, so this -- is only used for offsets from the GOT to symbol pointers inside the -- GOT. -picRelative ArchPPC OSLinux lbl +picRelative ArchPPC os lbl + | osElfTarget os = CmmLabelDiffOff lbl gotLabel 0 @@ -372,7 +402,7 @@ picRelative ArchPPC OSLinux lbl -- and a GotSymbolOffset label for other things. -- For reasons of tradition, the symbol offset label is written as a plain label. picRelative arch os lbl - | os == OSLinux || (os == OSDarwin && arch == ArchX86_64) + | osElfTarget os || (os == OSDarwin && arch == ArchX86_64) = let result | Just (SymbolPtr, lbl') <- dynamicLinkerLabelInfo lbl = CmmLabel $ mkDynamicLinkerLabel GotSymbolPtr lbl' @@ -409,12 +439,12 @@ needImportedSymbols arch os = True -- PowerPC Linux: -fPIC or -dynamic - | os == OSLinux + | osElfTarget os , arch == ArchPPC = opt_PIC || not opt_Static -- i386 (and others?): -dynamic but not -fPIC - | os == OSLinux + | osElfTarget os , arch /= ArchPPC_64 = not opt_Static && not opt_PIC @@ -426,8 +456,10 @@ needImportedSymbols arch os -- position-independent code. gotLabel :: CLabel gotLabel - = mkForeignLabel -- HACK: it's not really foreign - (fsLit ".LCTOC1") Nothing False IsData + -- HACK: this label isn't really foreign + = mkForeignLabel + (fsLit ".LCTOC1") + Nothing ForeignLabelInThisPackage IsData @@ -453,12 +485,14 @@ pprGotDeclaration _ OSDarwin -- 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 arch OSLinux - | arch /= ArchPPC_64 +pprGotDeclaration arch os + | osElfTarget os + , arch /= ArchPPC_64 , not opt_PIC = Pretty.empty - | arch /= ArchPPC_64 + | osElfTarget os + , arch /= ArchPPC_64 = vcat [ ptext (sLit ".section \".got2\",\"aw\""), ptext (sLit ".LCTOC1 = .+32768") ] @@ -601,7 +635,7 @@ pprImportedSymbol _ OSDarwin _ -- 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. +-- when not opt_PIC && not opt_Static. -- -- 2) PowerPC Linux is just plain broken. -- While it's theoretically possible to use GOT offsets larger @@ -616,23 +650,26 @@ pprImportedSymbol _ OSDarwin _ -- the NCG will keep track of all DynamicLinkerLabels it uses -- and output each of them using pprImportedSymbol. -pprImportedSymbol ArchPPC_64 OSLinux _ +pprImportedSymbol ArchPPC_64 os _ + | osElfTarget os = empty -pprImportedSymbol _ OSLinux importedLbl - | Just (SymbolPtr, lbl) <- dynamicLinkerLabelInfo importedLbl - = let symbolSize = case wordWidth of - W32 -> sLit "\t.long" - W64 -> sLit "\t.quad" - _ -> panic "Unknown wordRep in pprImportedSymbol" +pprImportedSymbol _ os importedLbl + | osElfTarget os + = case dynamicLinkerLabelInfo importedLbl of + Just (SymbolPtr, lbl) + -> let symbolSize = case wordWidth of + W32 -> sLit "\t.long" + W64 -> sLit "\t.quad" + _ -> panic "Unknown wordRep in pprImportedSymbol" - in vcat [ - ptext (sLit ".section \".got2\", \"aw\""), - ptext (sLit ".LC_") <> pprCLabel_asm lbl <> char ':', - ptext symbolSize <+> pprCLabel_asm lbl ] + in vcat [ + ptext (sLit ".section \".got2\", \"aw\""), + ptext (sLit ".LC_") <> pprCLabel_asm lbl <> char ':', + ptext symbolSize <+> pprCLabel_asm lbl ] - -- PLT code stubs are generated automatically by the dynamic linker. - | otherwise = empty + -- PLT code stubs are generated automatically by the dynamic linker. + _ -> empty pprImportedSymbol _ _ _ = panic "PIC.pprImportedSymbol: no match" @@ -675,8 +712,9 @@ initializePicBase_ppc -> [NatCmmTop PPC.Instr] -> NatM [NatCmmTop PPC.Instr] -initializePicBase_ppc ArchPPC OSLinux picReg - (CmmProc info lab params (ListGraph blocks) : statics) +initializePicBase_ppc ArchPPC os picReg + (CmmProc info lab (ListGraph blocks) : statics) + | osElfTarget os = do gotOffLabel <- getNewLabelNat tmp <- getNewRegNat $ intSize wordWidth @@ -701,11 +739,11 @@ initializePicBase_ppc ArchPPC OSLinux picReg : PPC.ADD picReg picReg (PPC.RIReg tmp) : insns) - return (CmmProc info lab params (ListGraph (b' : tail blocks)) : gotOffset : statics) + return (CmmProc info lab (ListGraph (b' : tail blocks)) : gotOffset : statics) initializePicBase_ppc ArchPPC OSDarwin picReg - (CmmProc info lab params (ListGraph blocks) : statics) - = return (CmmProc info lab params (ListGraph (b':tail blocks)) : statics) + (CmmProc info lab (ListGraph blocks) : statics) + = return (CmmProc info lab (ListGraph (b':tail blocks)) : statics) where BasicBlock bID insns = head blocks b' = BasicBlock bID (PPC.FETCHPC picReg : insns) @@ -727,15 +765,16 @@ initializePicBase_x86 -> [NatCmmTop X86.Instr] -> NatM [NatCmmTop X86.Instr] -initializePicBase_x86 ArchX86 OSLinux picReg - (CmmProc info lab params (ListGraph blocks) : statics) - = return (CmmProc info lab params (ListGraph (b':tail blocks)) : statics) +initializePicBase_x86 ArchX86 os picReg + (CmmProc info lab (ListGraph blocks) : statics) + | osElfTarget os + = return (CmmProc info lab (ListGraph (b':tail blocks)) : statics) where BasicBlock bID insns = head blocks b' = BasicBlock bID (X86.FETCHGOT picReg : insns) initializePicBase_x86 ArchX86 OSDarwin picReg - (CmmProc info lab params (ListGraph blocks) : statics) - = return (CmmProc info lab params (ListGraph (b':tail blocks)) : statics) + (CmmProc info lab (ListGraph blocks) : statics) + = return (CmmProc info lab (ListGraph (b':tail blocks)) : statics) where BasicBlock bID insns = head blocks b' = BasicBlock bID (X86.FETCHPC picReg : insns)