Merge win:/cygdrive/c/ghc/git/dt

driver/utils/dynwrapper.c

+
+/*
+Need to concatenate this file with something that defines:
+LPTSTR path_dirs[];
+LPTSTR progDll;
+LPTSTR rtsDll;
+*/
+
+#include <stdarg.h>
+#include <stdio.h>
+#include <Windows.h>
+#include <Shlwapi.h>
+
+#include "Rts.h"
+
+void die(char *fmt, ...) {
+    va_list argp;
+
+    fprintf(stderr, "error: ");
+    va_start(argp, fmt);
+    vfprintf(stderr, fmt, argp);
+    va_end(argp);
+    fprintf(stderr, "\n");
+
+    exit(1);
+}
+
+LPTSTR getModuleFileName(void) {
+    HMODULE hExe;
+    LPTSTR exePath;
+    DWORD exePathSize;
+    DWORD res;
+
+    hExe = GetModuleHandle(NULL);
+    if (hExe == NULL) {
+        die("GetModuleHandle failed");
+    }
+
+    // 300 chars ought to be enough, but there are various cases where
+    // it might not be (e.g. unicode paths, or \\server\foo\... paths.
+    // So we start off with 300 and grow if necessary.
+    exePathSize = 300;
+    exePath = malloc(exePathSize);
+    if (exePath == NULL) {
+        die("Mallocing %d for GetModuleFileName failed", exePathSize);
+    }
+
+    while ((res = GetModuleFileName(hExe, exePath, exePathSize)) &&
+           (GetLastError() == ERROR_INSUFFICIENT_BUFFER)) {
+        exePathSize *= 2;
+        exePath = realloc(exePath, exePathSize);
+        if (exePath == NULL) {
+            die("Reallocing %d for GetModuleFileName failed", exePathSize);
+        }
+    }
+
+    if (!res) {
+        die("GetModuleFileName failed");
+    }
+    return exePath;
+}
+
+void setPath(void) {
+    LPTSTR *dir;
+    LPTSTR path;
+    int n;
+    int len = 0;
+    LPTSTR exePath, s;
+
+    exePath = getModuleFileName();
+    for(s = exePath; *s != '\0'; s++) {
+        if (*s == '\\') {
+            *s = '/';
+        }
+    }
+    s = StrRChr(exePath, NULL, '/');
+    if (s == NULL) {
+        die("No directory separator in executable path: %s", exePath);
+    }
+    s[0] = '\0';
+    n = s - exePath;
+
+    for (dir = path_dirs; *dir != NULL; dir++) {
+        len += n + 7/* /../../ */ + lstrlen(*dir) + 1/* semicolon */;
+    }
+    len++; // NUL
+
+    path = malloc(len);
+    if (path == NULL) {
+        die("Mallocing %d for PATH failed", len);
+    }
+    s = path;
+    for (dir = path_dirs; *dir != NULL; dir++) {
+        StrCpy(s, exePath);
+        s += n;
+        StrCpy(s, "/../../");
+        s += 7;
+        StrCpy(s, *dir);
+        s += lstrlen(*dir);
+        s[0] = ';';
+        s++;
+    }
+    s[0] = '\0';
+    free(exePath);
+
+    if (! SetEnvironmentVariable(TEXT("PATH"), path)) {
+        printf("SetEnvironmentVariable failed (%d)\n", GetLastError());
+    }
+    free(path);
+}
+
+HINSTANCE loadDll(LPTSTR dll) {
+    HINSTANCE h;
+    DWORD dw;
+    LPVOID lpMsgBuf;
+
+    h = LoadLibrary(dll);
+
+    if (h == NULL) {
+        dw = GetLastError();
+        FormatMessage(
+            FORMAT_MESSAGE_ALLOCATE_BUFFER |
+            FORMAT_MESSAGE_FROM_SYSTEM |
+            FORMAT_MESSAGE_IGNORE_INSERTS,
+            NULL,
+            dw,
+            MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+            (LPTSTR) &lpMsgBuf,
+            0, NULL );
+        die("loadDll %s failed: %d: %s\n", dll, dw, lpMsgBuf);
+    }
+
+    return h;
+}
+
+void *GetNonNullProcAddress(HINSTANCE h, char *sym) {
+    void *p;
+
+    p = GetProcAddress(h, sym);
+    if (p == NULL) {
+        die("Failed to find address for %s", sym);
+    }
+    return p;
+}
+
+HINSTANCE GetNonNullModuleHandle(LPTSTR dll) {
+    HINSTANCE h;
+
+    h = GetModuleHandle(dll);
+    if (h == NULL) {
+        die("Failed to get module handle for %s", dll);
+    }
+    return h;
+}
+
+typedef int (*hs_main_t)(int , char **, StgClosure *, RtsConfig);
+
+int main(int argc, char *argv[]) {
+    void *p;
+    HINSTANCE hRtsDll, hProgDll;
+    LPTSTR oldPath;
+
+    StgClosure *main_p;
+    RtsConfig *rts_config_p;
+    hs_main_t hs_main_p;
+
+    // MSDN says: An environment variable has a maximum size limit of
+    // 32,767 characters, including the null-terminating character.
+    oldPath = malloc(32767);
+    if (oldPath == NULL) {
+        die("Mallocing 32767 for oldPath failed");
+    }
+
+    if (!GetEnvironmentVariable(TEXT("PATH"), oldPath, 32767)) {
+        if (GetLastError() == ERROR_ENVVAR_NOT_FOUND) {
+            oldPath[0] = '\0';
+        }
+        else {
+            die("Looking up PATH env var failed");
+        }
+    }
+    setPath();
+    hProgDll = loadDll(progDll);
+    if (! SetEnvironmentVariable(TEXT("PATH"), oldPath)) {
+        printf("SetEnvironmentVariable failed (%d)\n", GetLastError());
+    }
+    free(oldPath);
+
+    hRtsDll = GetNonNullModuleHandle(rtsDll);
+
+    hs_main_p    = GetNonNullProcAddress(hRtsDll,  "hs_main");
+    rts_config_p = GetNonNullProcAddress(hRtsDll,  "defaultRtsConfig");
+    main_p       = GetNonNullProcAddress(hProgDll, "ZCMain_main_closure");
+
+    return hs_main_p(argc, argv, main_p, *rts_config_p);
+}
+

ghc.mk

@@ -204,6 +204,15 @@ GHCI_WAY = v
 HADDOCK_WAY = v
 endif
 
+WINDOWS_DYN_PROG_RTS := rts
+ifeq "$(GhcThreaded)" "YES"
+WINDOWS_DYN_PROG_RTS := $(WINDOWS_DYN_PROG_RTS)_thr
+endif
+ifeq "$(GhcDebugged)" "YES"
+WINDOWS_DYN_PROG_RTS := $(WINDOWS_DYN_PROG_RTS)_debug
+endif
+WINDOWS_DYN_PROG_RTS := $(WINDOWS_DYN_PROG_RTS)_dyn_LIB_NAME
+
 # -----------------------------------------------------------------------------
 # Compilation Flags
 
@@ -556,24 +565,6 @@ $(error Unknown integer library: $(INTEGER_LIBRARY))
 endif
 endif
 
-# ----------------------------------------
-# Special magic for the packages which link to the RTS
-# This is a rather ugly hack to fix dynamically linked GHC on Windows.
-# If GHC is linked with -threaded, then it links against libHSrts_thr.
-# But if base is linked against libHSrts, then both end up getting
-# loaded, and things go wrong. We therefore link the libraries that
-# link against the RTS with the same RTS flags that we link GHC with.
-ifeq "$(GhcThreaded)" "YES"
-libraries/ghc-prim_dist-install_MORE_HC_OPTS    += -threaded
-libraries/integer-gmp_dist-install_MORE_HC_OPTS += -threaded
-libraries/base_dist-install_MORE_HC_OPTS        += -threaded
-endif
-ifeq "$(GhcDebugged)" "YES"
-libraries/ghc-prim_dist-install_MORE_HC_OPTS    += -debug
-libraries/integer-gmp_dist-install_MORE_HC_OPTS += -debug
-libraries/base_dist-install_MORE_HC_OPTS        += -debug
-endif
-
 # ----------------------------------------
 # Workarounds for problems building DLLs on Windows
 

rules/build-prog.mk

@@ -204,8 +204,27 @@ $1/$2/build/tmp/$$($1_$2_PROG) $1/$2/build/tmp/$$($1_$2_PROG).dll : \
             $$(error Bad build stage)))),\
         $$$$($$(dep)_dist-$(if $(filter 0,$3),boot,install)_PROGRAM_DEP_LIB)))
 
+$1_$2_PROG_NEEDS_C_WRAPPER = NO
 ifeq "$$(Windows_Host) $$($1_$2_PROGRAM_WAY)" "YES dyn"
-$1/$2/build/tmp/$$($1_$2_PROG) : $1/$2/build/tmp/$$($1_$2_PROG).c $1/$2/build/tmp/$$($1_$2_PROG).dll | $$$$(dir $$$$@)/.
+ifneq "$$($1_$2_HS_SRCS)" ""
+$1_$2_PROG_NEEDS_C_WRAPPER = YES
+endif
+endif
+
+ifeq "$$($1_$2_PROG_NEEDS_C_WRAPPER)" "YES"
+
+$1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c: driver/utils/dynwrapper.c | $$$$(dir $$$$@)/.
+	$$(call removeFiles,$$@)
+	echo '#include <Windows.h>' >> $$@
+	echo 'LPTSTR path_dirs[] = {' >> $$@
+	$$(foreach d,$$($1_$2_DEP_LIB_REL_DIRS),$$(call make-command,echo '    TEXT("$$d")$$(comma)' >> $$@))
+	echo '    TEXT("$1/$2/build/tmp/"),' >> $$@
+	echo '    NULL};' >> $$@
+	echo 'LPTSTR progDll = TEXT("../../$1/$2/build/tmp/$$($1_$2_PROG).dll");' >> $$@
+	echo 'LPTSTR rtsDll = TEXT("$$($$(WINDOWS_DYN_PROG_RTS))");' >> $$@
+	cat driver/utils/dynwrapper.c >> $$@
+
+$1/$2/build/tmp/$$($1_$2_PROG) : $1/$2/build/tmp/$$($1_$2_PROG)-inplace-wrapper.c $1/$2/build/tmp/$$($1_$2_PROG).dll | $$$$(dir $$$$@)/.
 	$$(call cmd,$1_$2_HC) -no-hs-main -optc-g -optc-O0 $$< -o $$@
 
 $1/$2/build/tmp/$$($1_$2_PROG).dll : $$($1_$2_$$($1_$2_PROGRAM_WAY)_HS_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_C_OBJS) $$($1_$2_$$($1_$2_PROGRAM_WAY)_S_OBJS) $$($1_$2_OTHER_OBJS) | $$$$(dir $$$$@)/.

rules/distdir-way-opts.mk

@@ -132,6 +132,18 @@ $1_$2_$3_GHC_LD_OPTS += \
 else ifeq "$$(TargetOS_CPP)" "darwin"
 $1_$2_$3_GHC_LD_OPTS += -optl-Wl,-headerpad_max_install_names
 endif
+
+# This is a rather ugly hack to fix dynamically linked GHC on Windows.
+# If GHC is linked with -threaded, then it links against libHSrts_thr.
+# But if base is linked against libHSrts, then both end up getting
+# loaded, and things go wrong. We therefore link the libraries with the
+# same RTS flags that we link GHC with.
+ifeq "$$(GhcThreaded)" "YES"
+$1_$2_$3_GHC_LD_OPTS += -threaded
+endif
+ifeq "$$(GhcDebugged)" "YES"
+$1_$2_$3_GHC_LD_OPTS += -debug
+endif
 endif
 endif
 

utils/ghc-cabal/Main.hs

@@ -437,6 +437,7 @@ generate config_args distdir directory
                 variablePrefix ++ "_DEP_CC_OPTS = "                    ++ unwords (forDeps Installed.ccOptions),
                 variablePrefix ++ "_DEP_LIB_DIRS_SINGLE_QUOTED = "     ++ unwords wrappedLibraryDirs,
                 variablePrefix ++ "_DEP_LIB_DIRS_SEARCHPATH = "        ++ mkSearchPath libraryDirs,
+                variablePrefix ++ "_DEP_LIB_REL_DIRS = "               ++ unwords libraryRelDirs,
                 variablePrefix ++ "_DEP_LIB_REL_DIRS_SEARCHPATH = "    ++ mkSearchPath libraryRelDirs,
                 variablePrefix ++ "_DEP_EXTRA_LIBS = "                 ++ unwords (forDeps Installed.extraLibraries),
                 variablePrefix ++ "_DEP_LD_OPTS = "                    ++ unwords (forDeps Installed.ldOptions),