From 786db5767c7db0af9c4770d5a73c94606d4bdced Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 1 May 2002 15:46:15 +0000 Subject: [PATCH] [project @ 2002-05-01 15:46:14 by simonmar] Cleanup and overhaul the bogus dynamic library loading code in InteractiveUI. Bugs fixed: - when linking in extra_libraries from a package, we now search library_paths in addition to the default dlopen() paths. - the path-searching machinery for dynamic libraries specified on the command line was broken, it didn't work unless the library was found on the first path in the list. --- ghc/compiler/ghci/InteractiveUI.hs | 173 +++++++++++++++++++++++------------- ghc/includes/Linker.h | 4 +- ghc/rts/Linker.c | 17 +--- 3 files changed, 115 insertions(+), 79 deletions(-) diff --git a/ghc/compiler/ghci/InteractiveUI.hs b/ghc/compiler/ghci/InteractiveUI.hs index 8d3bd96..5e3c444 100644 --- a/ghc/compiler/ghci/InteractiveUI.hs +++ b/ghc/compiler/ghci/InteractiveUI.hs @@ -1,13 +1,17 @@ {-# OPTIONS -#include "Linker.h" -#include "SchedAPI.h" #-} ----------------------------------------------------------------------------- --- $Id: InteractiveUI.hs,v 1.121 2002/04/24 09:42:18 simonmar Exp $ +-- $Id: InteractiveUI.hs,v 1.122 2002/05/01 15:46:15 simonmar Exp $ -- -- GHC Interactive User Interface -- -- (c) The GHC Team 2000 -- ----------------------------------------------------------------------------- -module InteractiveUI ( interactiveUI, ghciWelcomeMsg ) where +module InteractiveUI ( + interactiveUI, -- :: CmState -> [FilePath] -> [LibrarySpec] -> IO () + LibrarySpec(..), + ghciWelcomeMsg + ) where #include "../includes/config.h" #include "HsVersions.h" @@ -70,7 +74,7 @@ import Monad import GlaExts ( unsafeCoerce# ) import Foreign ( nullPtr ) -import CString ( peekCString ) +import CString ( CString, peekCString, withCString ) ----------------------------------------------------------------------------- @@ -993,11 +997,24 @@ ghciUnblock (GHCi a) = GHCi $ \s -> Exception.unblock (a s) -- For dynamic objects only, try to find the object file in all the -- directories specified in v_Library_Paths before giving up. -type LibrarySpec - = Either FilePath String +data LibrarySpec = Object FilePath | DLL String -showLS (Left nm) = "(static) " ++ nm -showLS (Right nm) = "(dynamic) " ++ nm +-- Packages that don't need loading, because the compiler shares them with +-- the interpreted program. +dont_load_these = [ "rts" ] + +-- Packages that are already linked into GHCi. For mingw32, we only +-- skip gmp and rts, since std and after need to load the msvcrt.dll +-- library which std depends on. +loaded_in_ghci +# ifndef mingw32_TARGET_OS + = [ "std", "concurrent", "posix", "text", "util" ] +# else + = [ ] +# endif + +showLS (Object nm) = "(static) " ++ nm +showLS (DLL nm) = "(dynamic) " ++ nm linkPackages :: DynFlags -> [LibrarySpec] -> [PackageConfig] -> IO () linkPackages dflags cmdline_lib_specs pkgs @@ -1007,6 +1024,7 @@ linkPackages dflags cmdline_lib_specs pkgs if (null cmdline_lib_specs) then return () else do maybePutStr dflags "final link ... " + ok <- resolveObjs if ok then maybePutStrLn dflags "done." else throwDyn (InstallationError @@ -1016,15 +1034,15 @@ linkPackages dflags cmdline_lib_specs pkgs preloadLib dflags lib_paths lib_spec = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ") case lib_spec of - Left static_ish + Object static_ish -> do b <- preload_static lib_paths static_ish maybePutStrLn dflags (if b then "done." else "not found") - Right dll_unadorned + DLL dll_unadorned -> -- We add "" to the set of paths to try, so that -- if none of the real paths match, we force addDLL -- to look in the default dynamic-link search paths. - do maybe_errstr <- preload_dynamic (lib_paths++[""]) + do maybe_errstr <- loadDynamic (lib_paths++[""]) dll_unadorned case maybe_errstr of Nothing -> return () @@ -1046,80 +1064,107 @@ linkPackages dflags cmdline_lib_specs pkgs if not b then return False else loadObj name >> return True - -- return Nothing == success, else Just error message from addDLL - preload_dynamic [] name - = return Nothing - preload_dynamic (path:paths) rootname - = do -- addDLL returns NULL on success - maybe_errmsg <- addDLL path rootname - if maybe_errmsg == nullPtr - then preload_dynamic paths rootname - else do str <- peekCString maybe_errmsg - return (Just str) - give_up = (throwDyn . CmdLineError) "user specified .o/.so/.DLL could not be loaded." --- Packages that don't need loading, because the compiler shares them with --- the interpreted program. -dont_load_these = [ "rts" ] - --- Packages that are already linked into GHCi. For mingw32, we only --- skip gmp and rts, since std and after need to load the msvcrt.dll --- library which std depends on. -loaded_in_ghci -# ifndef mingw32_TARGET_OS - = [ "std", "concurrent", "posix", "text", "util" ] -# else - = [ ] -# endif - linkPackage :: DynFlags -> PackageConfig -> IO () linkPackage dflags pkg | name pkg `elem` dont_load_these = return () | otherwise = do - -- For each obj, try obj.o and if that fails, obj.so. - -- Complication: all the .so's must be loaded before any of the .o's. let dirs = library_dirs pkg - let objs = hs_libraries pkg ++ extra_libraries pkg - classifieds <- mapM (locateOneObj dirs) objs + let libs = hs_libraries pkg ++ extra_libraries pkg + classifieds <- mapM (locateOneObj dirs) libs - -- Don't load the .so libs if this is a package GHCi is already - -- linked against, because we'll already have the .so linked in. - let (so_libs, obj_libs) = partition isRight classifieds - let sos_first | name pkg `elem` loaded_in_ghci = obj_libs - | otherwise = so_libs ++ obj_libs + -- Complication: all the .so's must be loaded before any of the .o's. + let dlls = [ dll | DLL dll <- classifieds ] + objs = [ obj | Object obj <- classifieds ] maybePutStr dflags ("Loading package " ++ name pkg ++ " ... ") - mapM loadClassified sos_first + + -- If this package is already part of the GHCi binary, we'll already + -- have the right DLLs for this package loaded, so don't try to + -- load them again. + when (name pkg `notElem` loaded_in_ghci) $ + loadDynamics dirs dlls + + -- After loading all the DLLs, we can load the static objects. + mapM loadObj objs + maybePutStr dflags "linking ... " ok <- resolveObjs if ok then maybePutStrLn dflags "done." else panic ("can't load package `" ++ name pkg ++ "'") - where - isRight (Right _) = True - isRight (Left _) = False - -loadClassified :: LibrarySpec -> IO () -loadClassified (Left obj_absolute_filename) - = do loadObj obj_absolute_filename -loadClassified (Right dll_unadorned) - = do maybe_errmsg <- addDLL "" dll_unadorned -- doesn't seem right to me - if maybe_errmsg == nullPtr - then return () - else do str <- peekCString maybe_errmsg - throwDyn (CmdLineError ("can't load .so/.DLL for: " - ++ dll_unadorned ++ " (" ++ str ++ ")" )) +loadDynamics dirs [] = return () +loadDynamics dirs (dll:dlls) = do + r <- loadDynamic dirs dll + case r of + Nothing -> loadDynamics dirs dlls + Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: " + ++ dll ++ " (" ++ err ++ ")" )) + +-- Try to find an object file for a given library in the given paths. +-- If it isn't present, we assume it's a dynamic library. locateOneObj :: [FilePath] -> String -> IO LibrarySpec -locateOneObj [] obj - = return (Right obj) -- we assume -locateOneObj (d:ds) obj - = do let path = d ++ '/':obj ++ ".o" +locateOneObj [] lib + = return (DLL lib) -- we assume +locateOneObj (d:ds) lib + = do let path = d ++ '/':lib ++ ".o" b <- doesFileExist path - if b then return (Left path) else locateOneObj ds obj + if b then return (Object path) else locateOneObj ds lib + +-- ---------------------------------------------------------------------------- +-- Loading a dyanmic library (dlopen()-ish on Unix, LoadLibrary-ish on Win32) + +#ifdef mingw32_TARGET_OS +loadDynamic paths rootname = do + -- ignore paths on windows (why? --SDM) + maybe_errmsg <- addDLL rootname + if maybe_errmsg == nullPtr + then return Nothing + else do str <- peekCString maybe_errmsg + return (Just str) + +addDLL :: String -> String -> IO (Ptr CChar) +addDLL path lib = do + withCString path $ \c_path -> do + withCString lib $ \c_lib -> do + maybe_errmsg <- c_addDLL c_path c_lib + return maybe_errmsg + +#else + +-- return Nothing == success, else Just error message from dlopen +loadDynamic (path:paths) rootname = do + let dll = path ++ '/':mkSOName rootname + b <- doesFileExist dll + if not b + then loadDynamic paths rootname + else addDLL dll +loadDynamic [] rootname = do + -- tried all our known library paths, let dlopen() search its + -- own builtin paths now. + addDLL (mkSOName rootname) + +mkSOName root = "lib" ++ root ++ ".so" + +addDLL :: String -> IO (Maybe String) +addDLL str = do + maybe_errmsg <- withCString str $ \dll -> c_addDLL dll + if maybe_errmsg == nullPtr + then return Nothing + else do str <- peekCString maybe_errmsg + return (Just str) + +foreign import ccall "addDLL" unsafe + c_addDLL :: CString -> IO CString + +foreign import ccall "dlerror" unsafe + dlerror :: IO CString + +#endif ----------------------------------------------------------------------------- -- timing & statistics diff --git a/ghc/includes/Linker.h b/ghc/includes/Linker.h index 7a6cd22..c2fd399 100644 --- a/ghc/includes/Linker.h +++ b/ghc/includes/Linker.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Linker.h,v 1.3 2001/07/23 10:43:18 simonmar Exp $ + * $Id: Linker.h,v 1.4 2002/05/01 15:46:14 simonmar Exp $ * * (c) The GHC Team, 2000 * @@ -26,6 +26,6 @@ HsInt loadObj( char *path ); HsInt resolveObjs( void ); /* load a dynamic library */ -char *addDLL( char* path, char* dll_name ); +char *addDLL( char* dll_name ); #endif /* LINKER_H */ diff --git a/ghc/rts/Linker.c b/ghc/rts/Linker.c index 29dafaf..6d8c71c 100644 --- a/ghc/rts/Linker.c +++ b/ghc/rts/Linker.c @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Linker.c,v 1.88 2002/04/23 17:33:54 ken Exp $ + * $Id: Linker.c,v 1.89 2002/05/01 15:46:14 simonmar Exp $ * * (c) The GHC Team, 2000, 2001 * @@ -473,23 +473,14 @@ static OpenedDLL* opened_dlls = NULL; -char* -addDLL ( __attribute((unused)) char* path, char* dll_name ) +char * +addDLL( char *dll_name ) { # if defined(OBJFORMAT_ELF) void *hdl; - char *buf; char *errmsg; - if (path == NULL || strlen(path) == 0) { - buf = stgMallocBytes(strlen(dll_name) + 10, "addDll"); - sprintf(buf, "lib%s.so", dll_name); - } else { - buf = stgMallocBytes(strlen(path) + 1 + strlen(dll_name) + 10, "addDll"); - sprintf(buf, "%s/lib%s.so", path, dll_name); - } - hdl = dlopen(buf, RTLD_NOW | RTLD_GLOBAL ); - free(buf); + hdl= dlopen(dll_name, RTLD_NOW | RTLD_GLOBAL); if (hdl == NULL) { /* dlopen failed; return a ptr to the error msg. */ errmsg = dlerror(); -- 1.7.10.4