Commit 81c69f30 authored by Simon Marlow's avatar Simon Marlow

Make the RTS linker API use wide-char pathnames on Windows (#5697)

I haven't been able to test whether this works or not due to #5754,
but at least it doesn't appear to break anything.
parent 9e452874
......@@ -36,12 +36,7 @@ import Control.Monad ( when )
import Foreign.C
import Foreign ( nullPtr )
import GHC.Exts ( Ptr(..) )
#if __GLASGOW_HASKELL__ >= 703
import GHC.IO.Encoding (getFileSystemEncoding)
#else
import GHC.IO.Encoding (TextEncoding, fileSystemEncoding)
#endif
import qualified GHC.Foreign as GHC
import System.Posix.Internals ( CFilePath, withFilePath )
import System.FilePath ( dropExtension )
......@@ -49,21 +44,10 @@ import System.FilePath ( dropExtension )
-- RTS Linker Interface
-- ---------------------------------------------------------------------------
#if __GLASGOW_HASKELL__ < 703
getFileSystemEncoding :: IO TextEncoding
getFileSystemEncoding = return fileSystemEncoding
#endif
-- UNICODE FIXME: Unicode object/archive/DLL file names on Windows will only work in the right code page
withFileCString :: FilePath -> (CString -> IO a) -> IO a
withFileCString fp f = do
enc <- getFileSystemEncoding
GHC.withCString enc fp f
insertSymbol :: String -> String -> Ptr a -> IO ()
insertSymbol obj_name key symbol
= let str = prefixUnderscore key
in withFileCString obj_name $ \c_obj_name ->
in withFilePath obj_name $ \c_obj_name ->
withCAString str $ \c_str ->
c_insertSymbol c_obj_name c_str symbol
......@@ -99,7 +83,7 @@ loadDLL str0 = do
str | isWindowsHost = dropExtension str0
| otherwise = str0
--
maybe_errmsg <- withFileCString str $ \dll -> c_addDLL dll
maybe_errmsg <- withFilePath str $ \dll -> c_addDLL dll
if maybe_errmsg == nullPtr
then return Nothing
else do str <- peekCString maybe_errmsg
......@@ -107,19 +91,19 @@ loadDLL str0 = do
loadArchive :: String -> IO ()
loadArchive str = do
withFileCString str $ \c_str -> do
withFilePath str $ \c_str -> do
r <- c_loadArchive c_str
when (r == 0) (panic ("loadArchive " ++ show str ++ ": failed"))
loadObj :: String -> IO ()
loadObj str = do
withFileCString str $ \c_str -> do
withFilePath str $ \c_str -> do
r <- c_loadObj c_str
when (r == 0) (panic ("loadObj " ++ show str ++ ": failed"))
unloadObj :: String -> IO ()
unloadObj str =
withFileCString str $ \c_str -> do
withFilePath str $ \c_str -> do
r <- c_unloadObj c_str
when (r == 0) (panic ("unloadObj " ++ show str ++ ": failed"))
......@@ -132,12 +116,12 @@ resolveObjs = do
-- Foreign declarations to RTS entry points which does the real work;
-- ---------------------------------------------------------------------------
foreign import ccall unsafe "addDLL" c_addDLL :: CString -> IO CString
foreign import ccall unsafe "addDLL" c_addDLL :: CFilePath -> IO CString
foreign import ccall unsafe "initLinker" initObjLinker :: IO ()
foreign import ccall unsafe "insertSymbol" c_insertSymbol :: CString -> CString -> Ptr a -> 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 "loadArchive" c_loadArchive :: CString -> IO Int
foreign import ccall unsafe "loadObj" c_loadObj :: CString -> IO Int
foreign import ccall unsafe "unloadObj" c_unloadObj :: CString -> IO Int
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
\end{code}
......@@ -14,31 +14,37 @@
#ifndef RTS_LINKER_H
#define RTS_LINKER_H
#if defined(mingw32_HOST_OS)
typedef wchar_t pathchar;
#else
typedef char pathchar;
#endif
/* initialize the object linker */
void initLinker( void );
/* insert a stable symbol in the hash table */
void insertStableSymbol(char* obj_name, char* key, StgPtr data);
void insertStableSymbol(pathchar* obj_name, char* key, StgPtr data);
/* insert a symbol in the hash table */
void insertSymbol(char* obj_name, char* key, void* data);
void insertSymbol(pathchar* obj_name, char* key, void* data);
/* lookup a symbol in the hash table */
void *lookupSymbol( char *lbl );
/* delete an object from the pool */
HsInt unloadObj( char *path );
HsInt unloadObj( pathchar *path );
/* add an obj (populate the global symbol table, but don't resolve yet) */
HsInt loadObj( char *path );
HsInt loadObj( pathchar *path );
/* add an arch (populate the global symbol table, but don't resolve yet) */
HsInt loadArchive( char *path );
HsInt loadArchive( pathchar *path );
/* resolve all the currently unlinked objects in memory */
HsInt resolveObjs( void );
/* load a dynamic library */
const char *addDLL( char* dll_name );
const char *addDLL( pathchar* dll_name );
#endif /* RTS_LINKER_H */
......@@ -131,7 +131,7 @@ static /*Str*/HashTable *stablehash;
ObjectCode *objects = NULL; /* initially empty */
static HsInt loadOc( ObjectCode* oc );
static ObjectCode* mkOc( char *path, char *image, int imageSize,
static ObjectCode* mkOc( pathchar *path, char *image, int imageSize,
char *archiveMemberName
#ifndef USE_MMAP
#ifdef darwin_HOST_OS
......@@ -140,6 +140,40 @@ static ObjectCode* mkOc( char *path, char *image, int imageSize,
#endif
);
// Use wchar_t for pathnames on Windows (#5697)
#if defined(mingw32_HOST_OS)
#define pathcmp wcscmp
#define pathlen wcslen
#define pathopen _wfopen
#define pathstat _wstat
#define struct_stat struct _stat
#define open wopen
#define WSTR(s) L##s
#define PATH_FMT "S"
#else
#define pathcmp strcmp
#define pathlen strlen
#define pathopen fopen
#define pathstat stat
#define struct_stat struct stat
#define WSTR(s) s
#define PATH_FMT "s"
#endif
static pathchar* pathdup(pathchar *path)
{
pathchar *ret;
#if defined(mingw32_HOST_OS)
ret = wcsdup(path);
#else
/* sigh, strdup() isn't a POSIX function, so do it the long way */
ret = stgMallocBytes( strlen(path)+1, "loadObj" );
strcpy(ret, path);
#endif
return ret;
}
#if defined(OBJFORMAT_ELF)
static int ocVerifyImage_ELF ( ObjectCode* oc );
static int ocGetNames_ELF ( ObjectCode* oc );
......@@ -1097,12 +1131,11 @@ static RtsSymbolVal rtsSyms[] = {
};
/* -----------------------------------------------------------------------------
* Insert symbols into hash tables, checking for duplicates.
*/
static void ghciInsertStrHashTable ( char* obj_name,
static void ghciInsertStrHashTable ( pathchar* obj_name,
HashTable *table,
char* key,
void *data
......@@ -1118,7 +1151,7 @@ static void ghciInsertStrHashTable ( char* obj_name,
"GHCi runtime linker: fatal error: I found a duplicate definition for symbol\n"
" %s\n"
"whilst processing object file\n"
" %s\n"
" %" PATH_FMT "\n"
"This could be caused by:\n"
" * Loading two different object files which export the same symbol\n"
" * Specifying the same object file twice on the GHCi command line\n"
......@@ -1175,7 +1208,7 @@ initLinker( void )
/* populate the symbol table with stuff from the RTS */
for (sym = rtsSyms; sym->lbl != NULL; sym++) {
ghciInsertStrHashTable("(GHCi built-in symbols)",
ghciInsertStrHashTable(WSTR("(GHCi built-in symbols)"),
symhash, sym->lbl, sym->addr);
IF_DEBUG(linker, debugBelch("initLinker: inserting rts symbol %s, %p\n", sym->lbl, sym->addr));
}
......@@ -1217,8 +1250,8 @@ initLinker( void )
* but are necessary for resolving symbols in GHCi, hence we load
* them manually here.
*/
addDLL("msvcrt");
addDLL("kernel32");
addDLL(WSTR("msvcrt"));
addDLL(WSTR("kernel32"));
#endif
IF_DEBUG(linker, debugBelch("initLinker: done\n"));
......@@ -1263,7 +1296,7 @@ exitLinker( void ) {
typedef
struct _OpenedDLL {
char* name;
pathchar* name;
struct _OpenedDLL* next;
HINSTANCE instance;
}
......@@ -1313,7 +1346,7 @@ internal_dlopen(const char *dll_name)
# endif
const char *
addDLL( char *dll_name )
addDLL( pathchar *dll_name )
{
# if defined(OBJFORMAT_ELF) || defined(OBJFORMAT_MACHO)
/* ------------------- ELF DLL loader ------------------- */
......@@ -1385,7 +1418,7 @@ addDLL( char *dll_name )
# elif defined(OBJFORMAT_PEi386)
/* ------------------- Win32 DLL loader ------------------- */
char* buf;
pathchar* buf;
OpenedDLL* o_dll;
HINSTANCE instance;
......@@ -1395,7 +1428,7 @@ addDLL( char *dll_name )
/* See if we've already got it, and ignore if so. */
for (o_dll = opened_dlls; o_dll != NULL; o_dll = o_dll->next) {
if (0 == strcmp(o_dll->name, dll_name))
if (0 == pathcmp(o_dll->name, dll_name))
return NULL;
}
......@@ -1409,19 +1442,19 @@ addDLL( char *dll_name )
point character (.) to indicate that the module name has no
extension. */
buf = stgMallocBytes(strlen(dll_name) + 10, "addDLL");
sprintf(buf, "%s.DLL", dll_name);
instance = LoadLibrary(buf);
buf = stgMallocBytes((pathlen(dll_name) + 10) * sizeof(wchar_t), "addDLL");
swprintf(buf, L"%s.DLL", dll_name);
instance = LoadLibraryW(buf);
if (instance == NULL) {
if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
// KAA: allow loading of drivers (like winspool.drv)
sprintf(buf, "%s.DRV", dll_name);
instance = LoadLibrary(buf);
swprintf(buf, L"%s.DRV", dll_name);
instance = LoadLibraryW(buf);
if (instance == NULL) {
if (GetLastError() != ERROR_MOD_NOT_FOUND) goto error;
// #1883: allow loading of unix-style libfoo.dll DLLs
sprintf(buf, "lib%s.DLL", dll_name);
instance = LoadLibrary(buf);
swprintf(buf, L"lib%s.DLL", dll_name);
instance = LoadLibraryW(buf);
if (instance == NULL) {
goto error;
}
......@@ -1431,8 +1464,7 @@ addDLL( char *dll_name )
/* Add this DLL to the list of DLLs in which to search for symbols. */
o_dll = stgMallocBytes( sizeof(OpenedDLL), "addDLL" );
o_dll->name = stgMallocBytes(1+strlen(dll_name), "addDLL");
strcpy(o_dll->name, dll_name);
o_dll->name = pathdup(dll_name);
o_dll->instance = instance;
o_dll->next = opened_dlls;
opened_dlls = o_dll;
......@@ -1441,7 +1473,7 @@ addDLL( char *dll_name )
error:
stgFree(buf);
sysErrorBelch(dll_name);
sysErrorBelch("%" PATH_FMT, dll_name);
/* LoadLibrary failed; return a ptr to the error msg. */
return "addDLL: could not load DLL";
......@@ -1456,7 +1488,7 @@ error:
*/
void
insertStableSymbol(char* obj_name, char* key, StgPtr p)
insertStableSymbol(pathchar* obj_name, char* key, StgPtr p)
{
ghciInsertStrHashTable(obj_name, stablehash, key, getStablePtr(p));
}
......@@ -1466,7 +1498,7 @@ insertStableSymbol(char* obj_name, char* key, StgPtr p)
* insert a symbol in the hash table
*/
void
insertSymbol(char* obj_name, char* key, void* data)
insertSymbol(pathchar* obj_name, char* key, void* data)
{
ghciInsertStrHashTable(obj_name, symhash, key, data);
}
......@@ -1646,7 +1678,7 @@ mmap_again:
#endif // USE_MMAP
static ObjectCode*
mkOc( char *path, char *image, int imageSize,
mkOc( pathchar *path, char *image, int imageSize,
char *archiveMemberName
#ifndef USE_MMAP
#ifdef darwin_HOST_OS
......@@ -1671,9 +1703,7 @@ mkOc( char *path, char *image, int imageSize,
# endif
oc->image = image;
/* sigh, strdup() isn't a POSIX function, so do it the long way */
oc->fileName = stgMallocBytes( strlen(path)+1, "loadObj" );
strcpy(oc->fileName, path);
oc->fileName = pathdup(path);
if (archiveMemberName) {
oc->archiveMemberName = stgMallocBytes( strlen(archiveMemberName)+1, "loadObj" );
......@@ -1703,7 +1733,7 @@ mkOc( char *path, char *image, int imageSize,
}
HsInt
loadArchive( char *path )
loadArchive( pathchar *path )
{
ObjectCode* oc;
char *image;
......@@ -1741,7 +1771,7 @@ loadArchive( char *path )
#endif
IF_DEBUG(linker, debugBelch("loadArchive: start\n"));
IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%s'\n", path));
IF_DEBUG(linker, debugBelch("loadArchive: Loading archive `%" PATH_FMT" '\n", path));
gnuFileIndex = NULL;
gnuFileIndexSize = 0;
......@@ -1749,7 +1779,7 @@ loadArchive( char *path )
fileNameSize = 32;
fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)");
f = fopen(path, "rb");
f = pathopen(path, WSTR("rb"));
if (!f)
barf("loadObj: can't read `%s'", path);
......@@ -1829,7 +1859,7 @@ loadArchive( char *path )
n = fread ( fileName, 1, 16, f );
if (n != 16) {
if (feof(f)) {
IF_DEBUG(linker, debugBelch("loadArchive: EOF while reading from '%s'\n", path));
IF_DEBUG(linker, debugBelch("loadArchive: EOF while reading from '%" PATH_FMT "'\n", path));
break;
}
else {
......@@ -2018,9 +2048,9 @@ loadArchive( char *path )
barf("loadArchive: error whilst reading `%s'", path);
}
archiveMemberName = stgMallocBytes(strlen(path) + thisFileNameSize + 3,
archiveMemberName = stgMallocBytes(pathlen(path) + thisFileNameSize + 3,
"loadArchive(file)");
sprintf(archiveMemberName, "%s(%.*s)",
sprintf(archiveMemberName, "%" PATH_FMT "(%.*s)",
path, (int)thisFileNameSize, fileName);
oc = mkOc(path, image, memberSize, archiveMemberName
......@@ -2102,12 +2132,12 @@ loadArchive( char *path )
* Returns: 1 if ok, 0 on error.
*/
HsInt
loadObj( char *path )
loadObj( pathchar *path )
{
ObjectCode* oc;
char *image;
int fileSize;
struct stat st;
struct_stat st;
int r;
#ifdef USE_MMAP
int fd;
......@@ -2117,7 +2147,7 @@ loadObj( char *path )
int misalignment;
# endif
#endif
IF_DEBUG(linker, debugBelch("loadObj %s\n", path));
IF_DEBUG(linker, debugBelch("loadObj %" PATH_FMT "\n", path));
initLinker();
......@@ -2129,7 +2159,7 @@ loadObj( char *path )
ObjectCode *o;
int is_dup = 0;
for (o = objects; o; o = o->next) {
if (0 == strcmp(o->fileName, path)) {
if (0 == pathcmp(o->fileName, path)) {
is_dup = 1;
break; /* don't need to search further */
}
......@@ -2138,14 +2168,14 @@ loadObj( char *path )
IF_DEBUG(linker, debugBelch(
"GHCi runtime linker: warning: looks like you're trying to load the\n"
"same object file twice:\n"
" %s\n"
" %" PATH_FMT "\n"
"GHCi will ignore this, but be warned.\n"
, path));
return 1; /* success */
}
}
r = stat(path, &st);
r = pathstat(path, &st);
if (r == -1) {
IF_DEBUG(linker, debugBelch("File doesn't exist\n"));
return 0;
......@@ -2170,9 +2200,9 @@ loadObj( char *path )
#else /* !USE_MMAP */
/* load the image into memory */
f = fopen(path, "rb");
f = pathopen(path, WSTR("rb"));
if (!f)
barf("loadObj: can't read `%s'", path);
barf("loadObj: can't read `%" PATH_FMT "'", path);
# if defined(mingw32_HOST_OS)
// TODO: We would like to use allocateExec here, but allocateExec
......@@ -2310,7 +2340,7 @@ resolveObjs( void )
* delete an object from the pool
*/
HsInt
unloadObj( char *path )
unloadObj( pathchar *path )
{
ObjectCode *oc, *prev;
HsBool unloadedAnyObj = HS_BOOL_FALSE;
......@@ -2322,7 +2352,7 @@ unloadObj( char *path )
prev = NULL;
for (oc = objects; oc; prev = oc, oc = oc->next) {
if (!strcmp(oc->fileName,path)) {
if (!pathcmp(oc->fileName,path)) {
/* Remove all the mappings for the symbols within this
* object..
......@@ -2365,7 +2395,7 @@ unloadObj( char *path )
return 1;
}
else {
errorBelch("unloadObj: can't find `%s' to unload", path);
errorBelch("unloadObj: can't find `%" PATH_FMT "' to unload", path);
return 0;
}
}
......@@ -2938,23 +2968,23 @@ ocVerifyImage_PEi386 ( ObjectCode* oc )
+ hdr->NumberOfSymbols * sizeof_COFF_symbol;
if (hdr->Machine != 0x14c) {
errorBelch("%s: Not x86 PEi386", oc->fileName);
errorBelch("%" PATH_FMT ": Not x86 PEi386", oc->fileName);
return 0;
}
if (hdr->SizeOfOptionalHeader != 0) {
errorBelch("%s: PEi386 with nonempty optional header", oc->fileName);
errorBelch("%" PATH_FMT ": PEi386 with nonempty optional header", oc->fileName);
return 0;
}
if ( /* (hdr->Characteristics & MYIMAGE_FILE_RELOCS_STRIPPED) || */
(hdr->Characteristics & MYIMAGE_FILE_EXECUTABLE_IMAGE) ||
(hdr->Characteristics & MYIMAGE_FILE_DLL) ||
(hdr->Characteristics & MYIMAGE_FILE_SYSTEM) ) {
errorBelch("%s: Not a PEi386 object file", oc->fileName);
errorBelch("%" PATH_FMT ": Not a PEi386 object file", oc->fileName);
return 0;
}
if ( (hdr->Characteristics & MYIMAGE_FILE_BYTES_REVERSED_HI)
/* || !(hdr->Characteristics & MYIMAGE_FILE_32BIT_MACHINE) */ ) {
errorBelch("%s: Invalid PEi386 word size or endiannness: %d",
errorBelch("%" PATH_FMT ": Invalid PEi386 word size or endiannness: %d",
oc->fileName,
(int)(hdr->Characteristics));
return 0;
......@@ -3229,7 +3259,7 @@ ocGetNames_PEi386 ( ObjectCode* oc )
&& 0!= strcmp(".reloc", (char*)secname)
&& 0 != strcmp(".rdata$zzz", (char*)secname)
) {
errorBelch("Unknown PEi386 section name `%s' (while processing: %s)", secname, oc->fileName);
errorBelch("Unknown PEi386 section name `%s' (while processing: %" PATH_FMT")", secname, oc->fileName);
stgFree(secname);
return 0;
}
......@@ -3448,7 +3478,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
COFF_section* section_sym
= findPEi386SectionCalled ( oc, sym->Name );
if (!section_sym) {
errorBelch("%s: can't find section `%s'", oc->fileName, sym->Name);
errorBelch("%" PATH_FMT ": can't find section `%s'", oc->fileName, sym->Name);
return 0;
}
S = ((UInt32)(oc->image))
......@@ -3458,7 +3488,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
copyName ( sym->Name, strtab, symbol, 1000-1 );
S = (UInt32) lookupSymbol( (char*)symbol );
if ((void*)S != NULL) goto foundit;
errorBelch("%s: unknown symbol `%s'", oc->fileName, symbol);
errorBelch("%" PATH_FMT ": unknown symbol `%s'", oc->fileName, symbol);
return 0;
foundit:;
}
......@@ -3496,7 +3526,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
*pP = S - ((UInt32)pP) - 4 + A;
break;
default:
debugBelch("%s: unhandled PEi386 relocation type %d",
debugBelch("%" PATH_FMT ": unhandled PEi386 relocation type %d",
oc->fileName, reltab_j->Type);
return 0;
}
......@@ -3504,7 +3534,7 @@ ocResolve_PEi386 ( ObjectCode* oc )
}
}
IF_DEBUG(linker, debugBelch("completed %s", oc->fileName));
IF_DEBUG(linker, debugBelch("completed %" PATH_FMT, oc->fileName));
return 1;
}
......
......@@ -61,7 +61,7 @@ typedef struct {
*/
typedef struct _ObjectCode {
OStatus status;
char* fileName;
pathchar *fileName;
int fileSize;
char* formatName; /* eg "ELF32", "DLL", "COFF", etc. */
......
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