Make the current module available to labelDynamic

It doesn't actually use it yet

1 files changed, 25 insertions, 20 deletions

diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index 6bf843affe..b36c0ae1e8 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -70,6 +70,7 @@ import CLabel           ( mkForeignLabel )
 
 
 import BasicTypes
+import Module
 
 import Outputable
 
@@ -99,9 +100,11 @@ data ReferenceKind
 
 class Monad m => CmmMakeDynamicReferenceM m where
     addImport :: CLabel -> m ()
+    getThisModule :: m Module
 
 instance CmmMakeDynamicReferenceM NatM where
     addImport = addImportNat
+    getThisModule = getThisModuleNat
 
 cmmMakeDynamicReference
   :: CmmMakeDynamicReferenceM m
@@ -115,10 +118,12 @@ cmmMakeDynamicReference dflags referenceKind lbl
   = return $ CmmLit $ CmmLabel lbl   -- already processed it, pass through
 
   | otherwise
-  = case howToAccessLabel
+  = do this_mod <- getThisModule
+       case howToAccessLabel
                 dflags
                 (platformArch $ targetPlatform dflags)
                 (platformOS   $ targetPlatform dflags)
+                this_mod
                 referenceKind lbl of
 
         AccessViaStub -> do
@@ -189,7 +194,7 @@ data LabelAccessStyle
         | AccessDirectly
 
 howToAccessLabel
-        :: DynFlags -> Arch -> OS -> ReferenceKind -> CLabel -> LabelAccessStyle
+        :: DynFlags -> Arch -> OS -> Module -> ReferenceKind -> CLabel -> LabelAccessStyle
 
 
 -- Windows
@@ -213,7 +218,7 @@ howToAccessLabel
 -- into the same .exe file. In this case we always access symbols directly,
 -- and never use __imp_SYMBOL.
 --
-howToAccessLabel dflags _ OSMinGW32 _ lbl
+howToAccessLabel dflags _ OSMinGW32 this_mod _ lbl
 
         -- Assume all symbols will be in the same PE, so just access them directly.
         | gopt Opt_Static dflags
@@ -221,7 +226,7 @@ howToAccessLabel dflags _ OSMinGW32 _ lbl
 
         -- If the target symbol is in another PE we need to access it via the
         --      appropriate __imp_SYMBOL pointer.
-        | labelDynamic dflags (thisPackage dflags) lbl
+        | labelDynamic dflags (thisPackage dflags) this_mod lbl
         = AccessViaSymbolPtr
 
         -- Target symbol is in the same PE as the caller, so just access it directly.
@@ -237,9 +242,9 @@ howToAccessLabel dflags _ OSMinGW32 _ lbl
 -- It is always possible to access something indirectly,
 -- even when it's not necessary.
 --
-howToAccessLabel dflags arch OSDarwin DataReference lbl
+howToAccessLabel dflags arch OSDarwin this_mod DataReference lbl
         -- data access to a dynamic library goes via a symbol pointer
-        | labelDynamic dflags (thisPackage dflags) lbl
+        | labelDynamic dflags (thisPackage dflags) this_mod lbl
         = AccessViaSymbolPtr
 
         -- when generating PIC code, all cross-module data references must
@@ -258,21 +263,21 @@ howToAccessLabel dflags arch OSDarwin DataReference lbl
         | otherwise
         = AccessDirectly
 
-howToAccessLabel dflags arch OSDarwin JumpReference lbl
+howToAccessLabel dflags arch OSDarwin this_mod JumpReference 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:
         | arch == ArchX86 || arch == ArchX86_64
-        , labelDynamic dflags (thisPackage dflags) lbl
+        , labelDynamic dflags (thisPackage dflags) this_mod lbl
         = AccessViaSymbolPtr
 
 
-howToAccessLabel dflags arch OSDarwin _ lbl
+howToAccessLabel dflags arch OSDarwin this_mod _ lbl
         -- 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.
         | arch /= ArchX86_64
-        , labelDynamic dflags (thisPackage dflags) lbl
+        , labelDynamic dflags (thisPackage dflags) this_mod lbl
         = AccessViaStub
 
         | otherwise
@@ -289,7 +294,7 @@ 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 os kind _
+howToAccessLabel _ ArchPPC_64 os _ kind _
         | osElfTarget os
         = if kind == DataReference
             -- ELF PPC64 (powerpc64-linux), AIX, MacOS 9, BeOS/PPC
@@ -297,7 +302,7 @@ howToAccessLabel _ ArchPPC_64 os kind _
             -- actually, .label instead of label
             else AccessDirectly
 
-howToAccessLabel dflags _ os _ _
+howToAccessLabel dflags _ 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.
@@ -305,11 +310,11 @@ howToAccessLabel dflags _ os _ _
         , not (gopt Opt_PIC dflags) && gopt Opt_Static dflags
         = AccessDirectly
 
-howToAccessLabel dflags arch os DataReference lbl
+howToAccessLabel dflags arch os this_mod DataReference lbl
         | osElfTarget os
         = case () of
             -- A dynamic label needs to be accessed via a symbol pointer.
-          _ | labelDynamic dflags (thisPackage dflags) lbl
+          _ | labelDynamic dflags (thisPackage dflags) this_mod lbl
             -> AccessViaSymbolPtr
 
             -- For PowerPC32 -fPIC, we have to access even static data
@@ -335,24 +340,24 @@ howToAccessLabel dflags arch os 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 os CallReference lbl
+howToAccessLabel dflags arch os this_mod CallReference lbl
         | osElfTarget os
-        , labelDynamic dflags (thisPackage dflags) lbl && not (gopt Opt_PIC dflags)
+        , labelDynamic dflags (thisPackage dflags) this_mod lbl && not (gopt Opt_PIC dflags)
         = AccessDirectly
 
         | osElfTarget os
         , arch /= ArchX86
-        , labelDynamic dflags (thisPackage dflags) lbl && gopt Opt_PIC dflags
+        , labelDynamic dflags (thisPackage dflags) this_mod lbl && gopt Opt_PIC dflags
         = AccessViaStub
 
-howToAccessLabel dflags _ os _ lbl
+howToAccessLabel dflags _ os this_mod _ lbl
         | osElfTarget os
-        = if labelDynamic dflags (thisPackage dflags) lbl
+        = if labelDynamic dflags (thisPackage dflags) this_mod lbl
             then AccessViaSymbolPtr
             else AccessDirectly
 
 -- all other platforms
-howToAccessLabel dflags _ _ _ _
+howToAccessLabel dflags _ _ _ _ _
         | not (gopt Opt_PIC dflags)
         = AccessDirectly