pool/ghc
SHA256
4
0
Fork 1
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
ghc/D349.patch
Peter Trommler c85b2f73b9 Accepting request 309163 from home:ptrommler:branches:devel:languages:haskell 
Add ppc64le native code generator. Back port of my upstream patch for ghc 7.12.

OBS-URL: https://build.opensuse.org/request/show/309163
OBS-URL: https://build.opensuse.org/package/show/devel:languages:haskell/ghc?expand=0&rev=177
2015-05-29 12:01:37 +00:00

294 lines
12 KiB
Diff
Raw Blame History

Index: ghc-7.8.4/compiler/ghci/Linker.lhs
===================================================================
--- ghc-7.8.4.orig/compiler/ghci/Linker.lhs
+++ ghc-7.8.4/compiler/ghci/Linker.lhs
@@ -123,7 +123,10 @@ data PersistentLinkerState
-- The currently-loaded packages; always object code
-- Held, as usual, in dependency order; though I am not sure if
-- that is really important
- pkgs_loaded :: ![PackageId]
+ pkgs_loaded :: ![PackageId],
+ -- we need to remember the name of the last temporary DLL/.so
+ -- so we can link it
+ last_temp_so :: !(Maybe FilePath)
}
emptyPLS :: DynFlags -> PersistentLinkerState
@@ -132,7 +135,8 @@ emptyPLS _ = PersistentLinkerState {
itbl_env = emptyNameEnv,
pkgs_loaded = init_pkgs,
bcos_loaded = [],
- objs_loaded = [] }
+ objs_loaded = [],
+ last_temp_so = Nothing }
-- Packages that don't need loading, because the compiler
-- shares them with the interpreted program.
@@ -314,14 +318,15 @@ reallyInitDynLinker dflags =
; if null cmdline_lib_specs then return pls
else do
- { mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
+ { pls1 <- foldM (preloadLib dflags lib_paths framework_paths) pls
+ cmdline_lib_specs
; maybePutStr dflags "final link ... "
; ok <- resolveObjs
; if succeeded ok then maybePutStrLn dflags "done"
else throwGhcExceptionIO (ProgramError "linking extra libraries/objects failed")
- ; return pls
+ ; return pls1
}}
@@ -360,19 +365,22 @@ classifyLdInput dflags f
return Nothing
where platform = targetPlatform dflags
-preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
-preloadLib dflags lib_paths framework_paths lib_spec
+preloadLib :: DynFlags -> [String] -> [String] -> PersistentLinkerState
+ -> LibrarySpec -> IO (PersistentLinkerState)
+preloadLib dflags lib_paths framework_paths pls lib_spec
= do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
case lib_spec of
Object static_ish
- -> do b <- preload_static lib_paths static_ish
+ -> do (b, pls1) <- preload_static lib_paths static_ish
maybePutStrLn dflags (if b then "done"
else "not found")
+ return pls1
Archive static_ish
-> do b <- preload_static_archive lib_paths static_ish
maybePutStrLn dflags (if b then "done"
else "not found")
+ return pls
DLL dll_unadorned
-> do maybe_errstr <- loadDLL (mkSOName platform dll_unadorned)
@@ -388,12 +396,14 @@ preloadLib dflags lib_paths framework_pa
case err2 of
Nothing -> maybePutStrLn dflags "done"
Just _ -> preloadFailed mm lib_paths lib_spec
+ return pls
DLLPath dll_path
-> do maybe_errstr <- loadDLL dll_path
case maybe_errstr of
Nothing -> maybePutStrLn dflags "done"
Just mm -> preloadFailed mm lib_paths lib_spec
+ return pls
Framework framework ->
if platformUsesFrameworks (targetPlatform dflags)
@@ -401,6 +411,7 @@ preloadLib dflags lib_paths framework_pa
case maybe_errstr of
Nothing -> maybePutStrLn dflags "done"
Just mm -> preloadFailed mm framework_paths lib_spec
+ return pls
else panic "preloadLib Framework"
where
@@ -420,11 +431,13 @@ preloadLib dflags lib_paths framework_pa
-- Not interested in the paths in the static case.
preload_static _paths name
= do b <- doesFileExist name
- if not b then return False
- else do if dynamicGhc
- then dynLoadObjs dflags [name]
- else loadObj name
- return True
+ if not b then return (False, pls)
+ else if dynamicGhc
+ then do pls1 <- dynLoadObjs dflags pls [name]
+ return (True, pls1)
+ else do loadObj name
+ return (True, pls)
+
preload_static_archive _paths name
= do b <- doesFileExist name
if not b then return False
@@ -791,8 +804,8 @@ dynLinkObjs dflags pls objs = do
wanted_objs = map nameOfObject unlinkeds
if dynamicGhc
- then do dynLoadObjs dflags wanted_objs
- return (pls1, Succeeded)
+ then do pls2 <- dynLoadObjs dflags pls1 wanted_objs
+ return (pls2, Succeeded)
else do mapM_ loadObj wanted_objs
-- Link them all together
@@ -806,9 +819,11 @@ dynLinkObjs dflags pls objs = do
pls2 <- unload_wkr dflags [] pls1
return (pls2, Failed)
-dynLoadObjs :: DynFlags -> [FilePath] -> IO ()
-dynLoadObjs _ [] = return ()
-dynLoadObjs dflags objs = do
+
+dynLoadObjs :: DynFlags -> PersistentLinkerState -> [FilePath]
+ -> IO PersistentLinkerState
+dynLoadObjs _ pls [] = return pls
+dynLoadObjs dflags pls objs = do
let platform = targetPlatform dflags
soFile <- newTempName dflags (soExt platform)
let -- When running TH for a non-dynamic way, we still need to make
@@ -816,10 +831,22 @@ dynLoadObjs dflags objs = do
-- Opt_Static off
dflags1 = gopt_unset dflags Opt_Static
dflags2 = dflags1 {
- -- We don't want to link the ldInputs in; we'll
- -- be calling dynLoadObjs with any objects that
- -- need to be linked.
- ldInputs = [],
+ -- We don't want the original ldInputs in
+ -- (they're already linked in), but we do want
+ -- to link against the previous dynLoadObjs
+ -- library if there was one, so that the linker
+ -- can resolve dependencies when it loads this
+ -- library.
+ ldInputs =
+ case last_temp_so pls of
+ Nothing -> []
+ Just so ->
+ let (lp, l) = splitFileName so in
+ [ Option ("-L" ++ lp)
+ , Option ("-Wl,-rpath")
+ , Option ("-Wl," ++ lp)
+ , Option ("-l:" ++ l)
+ ],
-- Even if we're e.g. profiling, we still want
-- the vanilla dynamic libraries, so we set the
-- ways / build tag to be just WayDyn.
@@ -831,7 +858,7 @@ dynLoadObjs dflags objs = do
consIORef (filesToNotIntermediateClean dflags) soFile
m <- loadDLL soFile
case m of
- Nothing -> return ()
+ Nothing -> return pls { last_temp_so = Just soFile }
Just err -> panic ("Loading temp shared object failed: " ++ err)
rmDupLinkables :: [Linkable] -- Already loaded
Index: ghc-7.8.4/compiler/main/SysTools.lhs
===================================================================
--- ghc-7.8.4.orig/compiler/main/SysTools.lhs
+++ ghc-7.8.4/compiler/main/SysTools.lhs
@@ -1416,6 +1416,7 @@ linkDynLib dflags0 o_files dep_packages
in package_hs_libs ++ extra_libs ++ other_flags
-- probably _stub.o files
+ -- and last temporary shaerd object file
let extra_ld_inputs = ldInputs dflags
case os of
@@ -1533,8 +1534,8 @@ linkDynLib dflags0 o_files dep_packages
-- Set the library soname. We use -h rather than -soname as
-- Solaris 10 doesn't support the latter:
++ [ Option ("-Wl,-h," ++ takeFileName output_fn) ]
- ++ map Option lib_path_opts
++ extra_ld_inputs
+ ++ map Option lib_path_opts
++ map Option pkg_lib_path_opts
++ map Option pkg_link_opts
)
Index: ghc-7.8.4/rts/Linker.c
===================================================================
--- ghc-7.8.4.orig/rts/Linker.c
+++ ghc-7.8.4/rts/Linker.c
@@ -1777,7 +1777,7 @@ internal_dlopen(const char *dll_name)
// (see POSIX also)
ACQUIRE_LOCK(&dl_mutex);
- hdl = dlopen(dll_name, RTLD_LAZY | RTLD_GLOBAL);
+ hdl = dlopen(dll_name, RTLD_LAZY|RTLD_LOCAL); /* see Note [RTLD_LOCAL] */
errmsg = NULL;
if (hdl == NULL) {
@@ -1787,11 +1787,12 @@ internal_dlopen(const char *dll_name)
errmsg_copy = stgMallocBytes(strlen(errmsg)+1, "addDLL");
strcpy(errmsg_copy, errmsg);
errmsg = errmsg_copy;
+ } else {
+ o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL");
+ o_so->handle = hdl;
+ o_so->next = openedSOs;
+ openedSOs = o_so;
}
- o_so = stgMallocBytes(sizeof(OpenedSO), "addDLL");
- o_so->handle = hdl;
- o_so->next = openedSOs;
- openedSOs = o_so;
RELEASE_LOCK(&dl_mutex);
//--------------- End critical section -------------------
@@ -1799,14 +1800,39 @@ internal_dlopen(const char *dll_name)
return errmsg;
}
+/*
+ Note [RTLD_LOCAL]
+
+ In GHCi we want to be able to override previous .so's with newly
+ loaded .so's when we recompile something. This further implies that
+ when we look up a symbol in internal_dlsym() we have to iterate
+ through the loaded libraries (in order from most recently loaded to
+ oldest) looking up the symbol in each one until we find it.
+
+ However, this can cause problems for some symbols that are copied
+ by the linker into the executable image at runtime - see #8935 for a
+ lengthy discussion. To solve that problem we need to look up
+ symbols in the main executable *first*, before attempting to look
+ them up in the loaded .so's. But in order to make that work, we
+ have to always call dlopen with RTLD_LOCAL, so that the loaded
+ libraries don't populate the global symbol table.
+*/
+
static void *
-internal_dlsym(void *hdl, const char *symbol) {
+internal_dlsym(const char *symbol) {
OpenedSO* o_so;
void *v;
// We acquire dl_mutex as concurrent dl* calls may alter dlerror
ACQUIRE_LOCK(&dl_mutex);
dlerror();
+ // look in program first
+ v = dlsym(dl_prog_handle, symbol);
+ if (dlerror() == NULL) {
+ RELEASE_LOCK(&dl_mutex);
+ return v;
+ }
+
for (o_so = openedSOs; o_so != NULL; o_so = o_so->next) {
v = dlsym(o_so->handle, symbol);
if (dlerror() == NULL) {
@@ -1814,7 +1840,6 @@ internal_dlsym(void *hdl, const char *sy
return v;
}
}
- v = dlsym(hdl, symbol);
RELEASE_LOCK(&dl_mutex);
return v;
}
@@ -1982,7 +2007,7 @@ lookupSymbol( char *lbl )
if (!ghciLookupSymbolTable(symhash, lbl, &val)) {
IF_DEBUG(linker, debugBelch("lookupSymbol: symbol not found\n"));
# if defined(OBJFORMAT_ELF)
- return internal_dlsym(dl_prog_handle, lbl);
+ return internal_dlsym(lbl);
# elif defined(OBJFORMAT_MACHO)
# if HAVE_DLFCN_H
/* On OS X 10.3 and later, we use dlsym instead of the old legacy
@@ -1996,7 +2021,7 @@ lookupSymbol( char *lbl )
*/
IF_DEBUG(linker, debugBelch("lookupSymbol: looking up %s with dlsym\n", lbl));
ASSERT(lbl[0] == '_');
- return internal_dlsym(dl_prog_handle, lbl + 1);
+ return internal_dlsym(lbl + 1);
# else
if (NSIsSymbolNameDefined(lbl)) {
NSSymbol symbol = NSLookupAndBindSymbol(lbl);
Reference in New Issue View Git Blame Copy Permalink