Commit 1a410093 authored by batterseapower's avatar batterseapower

Unicode fixes, taking into account PEP383 support

parent cfbf0eb1
......@@ -28,6 +28,8 @@ import Control.Monad ( when )
import Foreign.C
import Foreign ( nullPtr )
import GHC.Exts ( Ptr(..) )
import GHC.IO.Encoding ( fileSystemEncoding )
import qualified GHC.Foreign as GHC
......@@ -35,17 +37,21 @@ import GHC.Exts ( Ptr(..) )
-- RTS Linker Interface
-- ---------------------------------------------------------------------------
-- 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 = GHC.withCString fileSystemEncoding
insertSymbol :: String -> String -> Ptr a -> IO ()
insertSymbol obj_name key symbol
= let str = prefixUnderscore key
in withCString obj_name $ \c_obj_name ->
withCString str $ \c_str ->
in withFileCString obj_name $ \c_obj_name ->
withCAString str $ \c_str ->
c_insertSymbol c_obj_name c_str symbol
lookupSymbol :: String -> IO (Maybe (Ptr a))
lookupSymbol str_in = do
let str = prefixUnderscore str_in
withCString str $ \c_str -> do
withCAString str $ \c_str -> do
addr <- c_lookupSymbol c_str
if addr == nullPtr
then return Nothing
......@@ -60,7 +66,7 @@ loadDLL :: String -> IO (Maybe String)
-- Nothing => success
-- Just err_msg => failure
loadDLL str = do
maybe_errmsg <- withCString str $ \dll -> c_addDLL dll
maybe_errmsg <- withFileCString str $ \dll -> c_addDLL dll
if maybe_errmsg == nullPtr
then return Nothing
else do str <- peekCString maybe_errmsg
......@@ -68,19 +74,19 @@ loadDLL str = do
loadArchive :: String -> IO ()
loadArchive str = do
withCString str $ \c_str -> do
withFileCString str $ \c_str -> do
r <- c_loadArchive c_str
when (r == 0) (panic ("loadArchive " ++ show str ++ ": failed"))
loadObj :: String -> IO ()
loadObj str = do
withCString str $ \c_str -> do
withFileCString str $ \c_str -> do
r <- c_loadObj c_str
when (r == 0) (panic ("loadObj " ++ show str ++ ": failed"))
unloadObj :: String -> IO ()
unloadObj str =
withCString str $ \c_str -> do
withFileCString str $ \c_str -> do
r <- c_unloadObj c_str
when (r == 0) (panic ("unloadObj " ++ show str ++ ": failed"))
......
......@@ -822,14 +822,15 @@ getBaseDir :: IO (Maybe String)
#if defined(mingw32_HOST_OS)
-- Assuming we are running ghc, accessed by path $(stuff)/bin/ghc.exe,
-- return the path $(stuff)/lib.
getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
buf <- mallocArray len
ret <- getModuleFileName nullPtr buf len
if ret == 0 then free buf >> return Nothing
else do s <- peekCString buf
free buf
return (Just (rootDir s))
getBaseDir = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
where
try_size size = allocaArray (fromIntegral size) $ \buf -> do
ret <- c_GetModuleFileName nullPtr buf size
case ret of
0 -> return Nothing
_ | ret < size -> fmap (Just . rootDir) $ peekCWString buf
| otherwise -> try_size (size * 2)
rootDir s = case splitFileName $ normalise s of
(d, ghc_exe)
| lower ghc_exe `elem` ["ghc.exe",
......@@ -844,8 +845,8 @@ getBaseDir = do let len = (2048::Int) -- plenty, PATH_MAX is 512 under Win32.
where fail = panic ("can't decompose ghc.exe path: " ++ show s)
lower = map toLower
foreign import stdcall unsafe "GetModuleFileNameA"
getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
foreign import stdcall unsafe "windows.h GetModuleFileNameW"
c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
#else
getBaseDir = return Nothing
#endif
......
......@@ -219,6 +219,12 @@ DLL_IMPORT_RTS extern char **prog_argv; /* so we can get at these from Haskell *
DLL_IMPORT_RTS extern int prog_argc;
DLL_IMPORT_RTS extern char *prog_name;
#ifdef mingw32_HOST_OS
// We need these two from Haskell too
void getWin32ProgArgv(int *argc, wchar_t **argv[]);
void setWin32ProgArgv(int argc, wchar_t *argv[]);
#endif
void stackOverflow(void);
void stg_exit(int n) GNU_ATTRIBUTE(__noreturn__);
......
......@@ -387,6 +387,8 @@ typedef struct _RtsSymbolVal {
SymI_HasProto(stg_asyncReadzh) \
SymI_HasProto(stg_asyncWritezh) \
SymI_HasProto(stg_asyncDoProczh) \
SymI_HasProto(getWin32ProgArgv) \
SymI_HasProto(setWin32ProgArgv) \
SymI_HasProto(memset) \
SymI_HasProto(inet_ntoa) \
SymI_HasProto(inet_addr) \
......
......@@ -34,6 +34,14 @@ char **full_prog_argv = NULL;
char *prog_name = NULL; /* 'basename' of prog_argv[0] */
int rts_argc = 0; /* ditto */
char *rts_argv[MAX_RTS_ARGS];
#if defined(mingw32_HOST_OS)
// On Windows, we want to use GetCommandLineW rather than argc/argv,
// but we need to mutate the command line arguments for withProgName and
// friends. The System.Environment module achieves that using this bit of
// shared state:
int win32_prog_argc = 0;
wchar_t **win32_prog_argv = NULL;
#endif
/*
* constants, used later
......@@ -1536,3 +1544,53 @@ freeFullProgArgv (void)
full_prog_argc = 0;
full_prog_argv = NULL;
}
#if defined(mingw32_HOST_OS)
void freeWin32ProgArgv (void);
void
freeWin32ProgArgv (void)
{
int i;
if (win32_prog_argv != NULL) {
for (i = 0; i < win32_prog_argc; i++) {
stgFree(win32_prog_argv[i]);
}
stgFree(win32_prog_argv);
}
win32_prog_argc = 0;
win32_prog_argv = NULL;
}
void
getWin32ProgArgv(int *argc, wchar_t **argv[])
{
*argc = win32_prog_argc;
*argv = win32_prog_argv;
}
void
setWin32ProgArgv(int argc, wchar_t *argv[])
{
int i;
freeWin32ProgArgv();
win32_prog_argc = argc;
if (argv == NULL) {
win32_prog_argv = NULL;
return;
}
win32_prog_argv = stgCallocBytes(argc + 1, sizeof (wchar_t *),
"setWin32ProgArgv 1");
for (i = 0; i < argc; i++) {
win32_prog_argv[i] = stgMallocBytes((wcslen(argv[i]) + 1) * sizeof(wchar_t),
"setWin32ProgArgv 2");
wcscpy(win32_prog_argv[i], argv[i]);
}
win32_prog_argv[argc] = NULL;
}
#endif
......@@ -1487,16 +1487,17 @@ getExecDir cmd =
removeCmdSuffix = return . Just . initN (length cmd) . unDosifyPath
getExecPath :: IO (Maybe String)
getExecPath =
allocaArray len $ \buf -> do
ret <- getModuleFileName nullPtr buf len
if ret == 0 then return Nothing
else liftM Just $ peekCString buf
where len = 2048 -- Plenty, PATH_MAX is 512 under Win32.
foreign import stdcall unsafe "GetModuleFileNameA"
getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
where
try_size size = allocaArray (fromIntegral size) $ \buf -> do
ret <- c_GetModuleFileName nullPtr buf size
case ret of
0 -> return Nothing
_ | ret < size -> fmap Just $ peekCWString buf
| otherwise -> try_size (size * 2)
foreign import stdcall unsafe "windows.h GetModuleFileNameW"
c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
#else
getLibDir :: IO (Maybe String)
getLibDir = return Nothing
......
......@@ -149,15 +149,17 @@ dieProg msg = do
getExecPath :: IO (Maybe String)
#if defined(mingw32_HOST_OS)
getExecPath =
allocaArray len $ \buf -> do
ret <- getModuleFileName nullPtr buf len
if ret == 0 then return Nothing
else liftM Just $ peekCString buf
where len = 2048 -- Plenty, PATH_MAX is 512 under Win32.
foreign import stdcall unsafe "GetModuleFileNameA"
getModuleFileName :: Ptr () -> CString -> Int -> IO Int32
getExecPath = try_size 2048 -- plenty, PATH_MAX is 512 under Win32.
where
try_size size = allocaArray (fromIntegral size) $ \buf -> do
ret <- c_GetModuleFileName nullPtr buf size
case ret of
0 -> return Nothing
_ | ret < size -> fmap Just $ peekCWString buf
| otherwise -> try_size (size * 2)
foreign import stdcall unsafe "windows.h GetModuleFileNameW"
c_GetModuleFileName :: Ptr () -> CWString -> Word32 -> IO Word32
#else
getExecPath = return Nothing
#endif
......
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