use Unicode for Windows error messages (#521)

racket/src/ChezScheme/LOG

@@ -2126,3 +2126,6 @@
     c/Makefile.*nt
 - use lowercase for Windows include files
     segment.c, windows.c
+- proper unicode handling when retrieving error messages from the OS
+  on Windows
+    windows.c

racket/src/ChezScheme/c/externs.h

@@ -438,7 +438,7 @@ extern INT S_getpagesize(void);
 extern ptr S_LastErrorString(void);
 extern void *S_ntdlopen(const char *path);
 extern void *S_ntdlsym(void *h, const char *s);
-extern char *S_ntdlerror(void);
+extern ptr S_ntdlerror(void);
 extern int S_windows_flock(int fd, int operation);
 extern int S_windows_chdir(const char *pathname);
 extern int S_windows_chmod(const char *pathname, int mode);

racket/src/ChezScheme/c/foreign.c

@@ -36,13 +36,14 @@
 #if defined(HPUX)
 #include <dl.h>
 #define dlopen(path,flags) (void *)shl_load(path, BIND_IMMEDIATE, 0L)
-#define dlerror() strerror(errno)
+#define s_dlerror() Sstring_utf8(strerror(errno), -1)
 #elif defined(WIN32)
 #define dlopen(path,flags) S_ntdlopen(path)
 #define dlsym(h,s) S_ntdlsym(h,s)
-#define dlerror() S_ntdlerror()
+#define s_dlerror() S_ntdlerror()
 #else
 #include <dlfcn.h>
+#define s_dlerror() Sstring_utf8(dlerror(), -1)
 #ifndef RTLD_NOW
 #define RTLD_NOW 2
 #endif /* RTLD_NOW */
@@ -230,8 +231,7 @@ static void load_shared_object(path) const char *path; {
 
     handle = dlopen(path, RTLD_NOW);
     if (handle == (void *)NULL)
-        S_error2("", "(while loading ~a) ~a", Sstring_utf8(path, -1),
-                    Sstring_utf8(dlerror(), -1));
+        S_error2("", "(while loading ~a) ~a", Sstring_utf8(path, -1), s_dlerror());
     S_foreign_dynamic = Scons(addr_to_ptr(handle), S_foreign_dynamic);
 
     tc_mutex_release();

racket/src/ChezScheme/c/windows.c

@@ -21,6 +21,7 @@
 #include <io.h>
 #include <sys/stat.h>
 
+static ptr s_ErrorStringImp(DWORD dwMessageId, const char *lpcDefault);
 static ptr s_ErrorString(DWORD dwMessageId);
 static IUnknown *s_CreateInstance(CLSID *pCLSID, IID *iid);
 static ptr s_GetRegistry(wchar_t *s);
@@ -52,17 +53,10 @@ void *S_ntdlsym(void *h, const char *s) {
     return (void *)GetProcAddress(h, s);
 }
 
-/* S_ntdlerror courtesy of Bob Burger, burgerrg@sagian.com */
-char *S_ntdlerror(void) {
-    static char s[80];
-    INT n;
-
-    n = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(),
-                      0, (LPTSTR)s, 80, NULL);
-    if (n == 0) return "unable to load library";
-  /* Strip trailing period, newline & return when present */
-    if (n >= 3 && s[n-3] == '.') s[n-3] = 0;
-    return s;
+/* Initial version of S_ntdlerror courtesy of Bob Burger
+ * Modifications by James-Adam Renquinha Henri, jarhmander@gmail.com */
+ptr S_ntdlerror(void) {
+    return s_ErrorStringImp(GetLastError(), "unable to load library");
 }
 
 #ifdef FLUSHCACHE
@@ -242,33 +236,48 @@ static IUnknown *s_CreateInstance(CLSID *pCLSID, IID *iid) {
 }
 
 static ptr s_ErrorString(DWORD dwMessageId) {
-    char *lpMsgBuf;
+    return s_ErrorStringImp(dwMessageId, NULL);
+}
+
+static ptr s_ErrorStringImp(DWORD dwMessageId, const char *lpcDefault) {
+    wchar_t *lpMsgBuf;
     DWORD len;
+    char *u8str;
     ptr result;
 
-    len = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
-                        NULL, dwMessageId, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPTSTR)&lpMsgBuf, 0, NULL);
-    /* If FormatMessage fails, use the error code in hexadecimal. */
+    len = FormatMessageW(FORMAT_MESSAGE_ALLOCATE_BUFFER | FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
+                         NULL, dwMessageId, MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), (LPWSTR)&lpMsgBuf, 0, NULL);
+    /* If FormatMessage fails... */
     if (len == 0) {
-#define HEXERRBUFSIZ ((sizeof(dwMessageId) * 2) + 3)
-        char hexerrbuf[HEXERRBUFSIZ];
-        snprintf(hexerrbuf, HEXERRBUFSIZ, "0x%x", (unsigned int)dwMessageId);
-        return Sstring(hexerrbuf);
-#undef HEXERRBUFSIZ
+        if (lpcDefault) {
+            /* ... use the default string if provided... */
+            return Sstring_utf8(lpcDefault, -1);
+        } else {
+            /* ...otherwise, use the error code in hexadecimal. */
+            char buf[(sizeof(dwMessageId) * 2) + 3];
+            int n = snprintf(buf, sizeof(buf), "0x%x", dwMessageId);
+            if (n < sizeof(buf))
+                return Sstring_utf8(buf, n);
+            else
+                return Sstring("??");
+        }
     }
-    /* Otherwise remove trailing newlines & returns and strip trailing period. */
+    /* Otherwise remove trailing newlines & returns and strip trailing period, if present. */
     while (len > 0) {
-        char c = lpMsgBuf[len - 1];
-        if (c == '\n' || c == '\r')
+        wchar_t c = lpMsgBuf[len - 1];
+        if (c == L'\n' || c == '\r')
             len--;
-        else if (c == '.') {
+        else if (c == L'.') {
             len--;
             break;
         }
         else break;
     }
-    result = Sstring_of_length(lpMsgBuf, len);
+    lpMsgBuf[len] = 0;
+    u8str = Swide_to_utf8(lpMsgBuf);
     LocalFree(lpMsgBuf);
+    result = Sstring_utf8(u8str, -1);
+    free(u8str);
     return result;
 }