Commit acce37f3 authored by Tamar Christina's avatar Tamar Christina Committed by Ben Gamari

Fix archive loading on Windows by the runtime loader

The runtime loader is unable to find archive files `.a` shipping
with the inplace `GCC`.

It seems the issue is caused by `findArchive` being unable to
find any archives that are shipped using the in-place `GCC`.

- It works on Linux because `findArchive` would search
  the standard Linux include path.
- It works during compilation because `GCC` can find it's own libraries
  (we explicitly tell it where to look for libraries using the `gcc`
  wrapper around `realgcc`)

So fixing the issue means using `searchForLibUsingGcc` in `findArchive`
as well, which will then find the correct file.

The reason for the error as it is, is because if we can't locate the
library using any of the methods we have, we assume it is a system dll,
or something on the system search path.  e.g. if trying to load
`kernel32.dll`.

There is a slight issue in that the `GHCi` code (incorrectly) favors
`static archives` over `dynamic` ones

```
findDll        `orElse`
findArchive    `orElse`
tryGcc         `orElse`
tryGccPrefixed `orElse`
assumeDll
```
This has the unwanted effect of when `kernel32` is specified as a lib,
it will try to load `kernel32.a` instead of `kernel32.dll`.

To solve this I have added another search function that is able to
search the Windows search paths using `SearchPath` in order to find if
it is a dll on the system search path.

The new search order is:

```
findDll     `orElse`
findSysDll  `orElse`
tryGcc      `orElse`
findArchive `orElse`
assumeDll
```

(`tryGccPrefixed` was rolled into `tryGcc` so it is no longer needed at
top level)

Test Plan: ./validate added new windows tests T3242

Reviewers: thomie, erikd, hvr, austin, bgamari

Reviewed By: thomie, erikd, bgamari

Differential Revision: https://phabricator.haskell.org/D1455

GHC Trac Issues: #3242
parent 8ad9e74f
......@@ -55,6 +55,7 @@ import SysTools
-- Standard libraries
import Control.Monad
import Control.Applicative((<|>))
import Data.IORef
import Data.List
......@@ -1209,20 +1210,25 @@ locateLib dflags is_hs dirs lib
-- For non-Haskell libraries (e.g. gmp, iconv):
-- first look in library-dirs for a dynamic library (libfoo.so)
-- then look in library-dirs for a static library (libfoo.a)
-- first look in library-dirs and inplace GCC for a dynamic library (libfoo.so)
-- then check for system dynamic libraries (e.g. kernel32.dll on windows)
-- then try "gcc --print-file-name" to search gcc's search path
-- then look in library-dirs and inplace GCC for a static library (libfoo.a)
-- for a dynamic library (#5289)
-- otherwise, assume loadDLL can find it
--
= findDll `orElse`
= findDll `orElse`
findSysDll `orElse`
tryGcc `orElse`
findArchive `orElse`
tryGcc `orElse`
tryGccPrefixed `orElse`
assumeDll
| dynamicGhc
-- When the GHC package was compiled as dynamic library (=DYNAMIC set),
-- we search for .so libraries first.
= findHSDll `orElse` findDynObject `orElse` assumeDll
= findHSDll `orElse`
findDynObject `orElse`
assumeDll
| rtsIsProfiled
-- When the GHC package is profiled, only a libHSfoo_p.a archive will do.
......@@ -1232,7 +1238,7 @@ locateLib dflags is_hs dirs lib
| otherwise
-- HSfoo.o is the best, but only works for the normal way
-- libHSfoo.a is the backup option.
= findObject `orElse`
= findObject `orElse`
findArchive `orElse`
assumeDll
......@@ -1253,11 +1259,15 @@ locateLib dflags is_hs dirs lib
findObject = liftM (fmap Object) $ findFile dirs obj_file
findDynObject = liftM (fmap Object) $ findFile dirs dyn_obj_file
findArchive = liftM (fmap Archive) $ findFile dirs arch_file
findArchive = let local = liftM (fmap Archive) $ findFile dirs arch_file
linked = liftM (fmap Archive) $ searchForLibUsingGcc dflags arch_file dirs
in liftM2 (<|>) local linked
findHSDll = liftM (fmap DLLPath) $ findFile dirs hs_dyn_lib_file
findDll = liftM (fmap DLLPath) $ findFile dirs dyn_lib_file
tryGcc = liftM (fmap DLLPath) $ searchForLibUsingGcc dflags so_name dirs
tryGccPrefixed = liftM (fmap DLLPath) $ searchForLibUsingGcc dflags lib_so_name dirs
findSysDll = fmap (fmap $ DLL . takeFileName) $ findSystemLibrary so_name
tryGcc = let short = liftM (fmap DLLPath) $ searchForLibUsingGcc dflags so_name dirs
full = liftM (fmap DLLPath) $ searchForLibUsingGcc dflags lib_so_name dirs
in liftM2 (<|>) short full
assumeDll = return (DLL lib)
infixr `orElse`
......
......@@ -9,16 +9,17 @@
-- | Primarily, this module consists of an interface to the C-land
-- dynamic linker.
module ObjLink (
initObjLinker, -- :: IO ()
loadDLL, -- :: String -> IO (Maybe String)
loadArchive, -- :: String -> IO ()
loadObj, -- :: String -> IO ()
unloadObj, -- :: String -> IO ()
insertSymbol, -- :: String -> String -> Ptr a -> IO ()
lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
resolveObjs, -- :: IO SuccessFlag
addLibrarySearchPath, -- :: CFilePath -> IO (Ptr ())
removeLibrarySearchPath -- :: Ptr() -> IO Bool
initObjLinker, -- :: IO ()
loadDLL, -- :: String -> IO (Maybe String)
loadArchive, -- :: String -> IO ()
loadObj, -- :: String -> IO ()
unloadObj, -- :: String -> IO ()
insertSymbol, -- :: String -> String -> Ptr a -> IO ()
lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
resolveObjs, -- :: IO SuccessFlag
addLibrarySearchPath, -- :: FilePath -> IO (Ptr ())
removeLibrarySearchPath, -- :: Ptr () -> IO Bool
findSystemLibrary -- :: FilePath -> IO (Maybe FilePath)
) where
import Panic
......@@ -28,9 +29,10 @@ import Util
import Control.Monad ( when )
import Foreign.C
import Foreign.Marshal.Alloc ( free )
import Foreign ( nullPtr )
import GHC.Exts ( Ptr(..) )
import System.Posix.Internals ( CFilePath, withFilePath )
import System.Posix.Internals ( CFilePath, withFilePath, peekFilePath )
import System.FilePath ( dropExtension, normalise )
......@@ -81,6 +83,7 @@ loadDLL str0 = do
if maybe_errmsg == nullPtr
then return Nothing
else do str <- peekCString maybe_errmsg
free maybe_errmsg
return (Just str)
loadArchive :: String -> IO ()
......@@ -108,6 +111,15 @@ addLibrarySearchPath str =
removeLibrarySearchPath :: Ptr () -> IO Bool
removeLibrarySearchPath = c_removeLibrarySearchPath
findSystemLibrary :: String -> IO (Maybe String)
findSystemLibrary str = do
result <- withFilePath str c_findSystemLibrary
case result == nullPtr of
True -> return Nothing
False -> do path <- peekFilePath result
free result
return $ Just path
resolveObjs :: IO SuccessFlag
resolveObjs = do
r <- c_resolveObjs
......@@ -120,10 +132,11 @@ resolveObjs = do
foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString
foreign import ccall unsafe "initLinker" initObjLinker :: IO ()
foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CFilePath -> CString -> Ptr a -> IO ()
foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
foreign import ccall unsafe "loadArchive" c_loadArchive :: CFilePath -> IO Int
foreign import ccall unsafe "loadObj" c_loadObj :: CFilePath -> IO Int
foreign import ccall unsafe "unloadObj" c_unloadObj :: CFilePath -> IO Int
foreign import ccall unsafe "resolveObjs" c_resolveObjs :: IO Int
foreign import ccall unsafe "addLibrarySearchPath" c_addLibrarySearchPath :: CFilePath -> IO (Ptr ())
foreign import ccall unsafe "removeLibrarySearchPath" c_removeLibrarySearchPath :: Ptr() -> IO Bool
foreign import ccall unsafe "removeLibrarySearchPath" c_removeLibrarySearchPath :: Ptr () -> IO Bool
foreign import ccall unsafe "findSystemLibrary" c_findSystemLibrary :: CFilePath -> IO CFilePath
......@@ -77,6 +77,13 @@ HsBool removeLibrarySearchPath(HsPtr dll_path_index);
the linker work better */
void warnMissingKBLibraryPaths( void );
/* -----------------------------------------------------------------------------
* Searches the system directories to determine if there is a system DLL that
* satisfies the given name. This prevent GHCi from linking against a static
* library if a DLL is available.
*/
pathchar* findSystemLibrary(pathchar* dll_name);
/* called by the initialization code for a module, not a user API */
StgStablePtr foreignExportStablePtr (StgPtr p);
......
......@@ -917,6 +917,43 @@ error:
# endif
}
/* -----------------------------------------------------------------------------
* Searches the system directories to determine if there is a system DLL that
* satisfies the given name. This prevent GHCi from linking against a static
* library if a DLL is available.
*
* Returns: NULL on failure or no DLL found, else the full path to the DLL
* that can be loaded.
*/
pathchar* findSystemLibrary(pathchar* dll_name)
{
IF_DEBUG(linker, debugBelch("\nfindSystemLibrary: dll_name = `%" PATH_FMT "'\n", dll_name));
#if defined(OBJFORMAT_PEi386)
const unsigned int init_buf_size = 1024;
unsigned int bufsize = init_buf_size;
wchar_t* result = malloc(sizeof(wchar_t) * bufsize);
DWORD wResult = SearchPathW(NULL, dll_name, NULL, bufsize, result, NULL);
if (wResult > bufsize) {
result = realloc(result, sizeof(wchar_t) * wResult);
wResult = SearchPathW(NULL, dll_name, NULL, wResult, result, NULL);
}
if (!wResult) {
free(result);
return NULL;
}
return result;
#else
(void)(dll_name); // Function not implemented for other platforms.
return NULL;
#endif
}
/* -----------------------------------------------------------------------------
* Emits a warning determining that the system is missing a required security
......
......@@ -700,6 +700,7 @@
SymI_HasProto(addDLL) \
SymI_HasProto(addLibrarySearchPath) \
SymI_HasProto(removeLibrarySearchPath) \
SymI_HasProto(findSystemLibrary) \
SymI_HasProto(__int_encodeDouble) \
SymI_HasProto(__word_encodeDouble) \
SymI_HasProto(__int_encodeFloat) \
......
......@@ -59,4 +59,7 @@ compile_libAB_dyn:
.PHONY: T1407
T1407:
cat T1407.script | LD_LIBRARY_PATH=. "$(TEST_HC)" -ignore-dot-ghci -v0 --interactive -L.
cat T1407.script | LD_LIBRARY_PATH=. "$(TEST_HC)" $(TEST_HC_OPTS) -ignore-dot-ghci -v0 --interactive -L.
.PHONY: T3242
echo ":q" | '$(TEST_HC)' $(TEST_HC_OPTS) --interactive -ignore-dot-ghci -v0 -lm
......@@ -11,6 +11,11 @@ test('T1407',
extra_hc_opts('-L.')],
run_command, ['$MAKE --no-print-directory -s T1407'])
test('T3242',
[unless(doing_ghci, skip), unless(opsys('mingw32'), skip)],
run_command,
['$MAKE -s --no-print-directory T3242'])
test('T10955',
[unless(doing_ghci, skip),unless(opsys('mingw32'), skip),
extra_clean(['bin_dep/*', 'bin_dep']),
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment