From f3ed736d147549748db9c552bb8e9311b5be2353 Mon Sep 17 00:00:00 2001
From: Simon Marlow <marlowsd@gmail.com>
Date: Fri, 6 Jan 2012 14:51:40 +0000
Subject: [PATCH] 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.
---
compiler/ghci/ObjLink.lhs | 38 +++--------
includes/rts/Linker.h | 18 +++--
rts/Linker.c | 136 +++++++++++++++++++++++---------------
rts/LinkerInternals.h | 2 +-
4 files changed, 107 insertions(+), 87 deletions(-)
diff --git a/compiler/ghci/ObjLink.lhs b/compiler/ghci/ObjLink.lhs
index f467c7ada362..dedc9ceb2fc0 100644
--- a/compiler/ghci/ObjLink.lhs
+++ b/compiler/ghci/ObjLink.lhs
@@ -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}
diff --git a/includes/rts/Linker.h b/includes/rts/Linker.h
index f7c8ce9c4b6f..e900e858c1f9 100644
--- a/includes/rts/Linker.h
+++ b/includes/rts/Linker.h
@@ -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 */
diff --git a/rts/Linker.c b/rts/Linker.c
index 7e3c7b1167d2..7fc6d0a80453 100644
--- a/rts/Linker.c
+++ b/rts/Linker.c
@@ -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;
}
diff --git a/rts/LinkerInternals.h b/rts/LinkerInternals.h
index d545c12ed959..dd4d7ed93905 100644
--- a/rts/LinkerInternals.h
+++ b/rts/LinkerInternals.h
@@ -61,7 +61,7 @@ typedef struct {
*/
typedef struct _ObjectCode {
OStatus status;
- char* fileName;
+ pathchar *fileName;
int fileSize;
char* formatName; /* eg "ELF32", "DLL", "COFF", etc. */
--
GitLab