+-- Left: full path name of a .o file, including trailing .o
+-- Right: "unadorned" name of a .DLL/.so
+-- e.g. On unix "qt" denotes "libqt.so"
+-- On WinDoze "burble" denotes "burble.DLL"
+-- addDLL is platform-specific and adds the lib/.so/.DLL
+-- suffixes platform-dependently; we don't do that here.
+--
+-- For dynamic objects only, try to find the object file in all the
+-- directories specified in v_Library_Paths before giving up.
+
+data LibrarySpec = Object FilePath | DLL String
+
+-- 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
+ = do mapM_ (linkPackage dflags) (reverse pkgs)
+ lib_paths <- readIORef v_Library_paths
+ mapM_ (preloadLib dflags lib_paths) cmdline_lib_specs
+ if (null cmdline_lib_specs)
+ then return ()
+ else do maybePutStr dflags "final link ... "
+
+ ok <- resolveObjs
+ if ok then maybePutStrLn dflags "done."
+ else throwDyn (InstallationError
+ "linking extra libraries/objects failed")
+ where
+ preloadLib :: DynFlags -> [String] -> LibrarySpec -> IO ()
+ preloadLib dflags lib_paths 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
+ maybePutStrLn dflags (if b then "done."
+ else "not found")
+ 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 <- loadDynamic (lib_paths++[""])
+ dll_unadorned
+ case maybe_errstr of
+ Nothing -> return ()
+ Just mm -> preloadFailed mm lib_paths lib_spec
+ maybePutStrLn dflags "done"
+
+ preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
+ preloadFailed sys_errmsg paths spec
+ = do maybePutStr dflags
+ ("failed.\nDynamic linker error message was:\n "
+ ++ sys_errmsg ++ "\nWhilst trying to load: "
+ ++ showLS spec ++ "\nDirectories to search are:\n"
+ ++ unlines (map (" "++) paths) )
+ give_up
+
+ -- not interested in the paths in the static case.
+ preload_static paths name
+ = do b <- doesFileExist name
+ if not b then return False
+ else loadObj name >> return True
+
+ give_up
+ = (throwDyn . CmdLineError)
+ "user specified .o/.so/.DLL could not be loaded."
+
+linkPackage :: DynFlags -> PackageConfig -> IO ()
+linkPackage dflags pkg
+ | name pkg `elem` dont_load_these = return ()
+ | otherwise
+ = do
+ let dirs = library_dirs pkg
+ let libs = hs_libraries pkg ++ extra_libraries pkg
+ classifieds <- mapM (locateOneObj dirs) 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 ++ " ... ")
+
+ -- 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 ++ "'")
+
+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 [] lib
+ = return (DLL lib) -- we assume
+locateOneObj (d:ds) lib
+ = do let path = d ++ '/':lib ++ ".o"
+ b <- doesFileExist path
+ 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 = addDLL rootname
+ -- ignore paths on windows (why? --SDM)
+
+#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"
+
+#endif
+
+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