#7772: Finish support for DYNAMIC_GHC_PROGRAMS on Windows ---------------------------------+------------------------------------------ Reporter: igloo | Owner: igloo Type: bug | Status: new Priority: high | Milestone: 7.8.1 Component: Compiler | Version: 7.7 Keywords: | Os: Unknown/Multiple Architecture: Unknown/Multiple | Failure: None/Unknown Difficulty: Unknown | Testcase: Blockedby: | Blocking: Related: | ---------------------------------+------------------------------------------ Finish support for `DYNAMIC_GHC_PROGRAMS` on Windows. {{{ #include <stdarg.h> #include <stdio.h> #include <Windows.h> #include <Shlwapi.h> #include "Rts.h" LPTSTR path_dirs[] = { TEXT("libraries/haskeline/dist-install/build"), TEXT("compiler/stage2/build"), TEXT("ghc/stage2/build/tmp"), TEXT("libraries/transformers/dist-install/build"), TEXT("libraries/template-haskell/dist-install/build"), TEXT("libraries/hpc/dist-install/build"), TEXT("libraries/hoopl/dist-install/build"), TEXT("libraries/bin-package-db/dist-install/build"), TEXT("libraries/binary/dist-install/build"), TEXT("libraries/Cabal/Cabal/dist-install/build"), TEXT("libraries/process/dist-install/build"), TEXT("libraries/pretty/dist-install/build"), TEXT("libraries/directory/dist-install/build"), TEXT("libraries/time/dist-install/build"), TEXT("libraries/old-locale/dist-install/build"), TEXT("libraries/filepath/dist-install/build"), TEXT("libraries/Win32/dist-install/build"), TEXT("libraries/containers/dist-install/build"), TEXT("libraries/bytestring/dist-install/build"), TEXT("libraries/deepseq/dist-install/build"), TEXT("libraries/array/dist-install/build"), TEXT("libraries/base/dist-install/build"), TEXT("libraries/integer-gmp/dist-install/build"), TEXT("libraries/ghc-prim/dist-install/build"), TEXT("rts/dist/build"), NULL }; 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); } void setPath(void) { LPTSTR *dir; LPTSTR path; int n; int len = 0; LPTSTR exePath, s; HMODULE hExe; hExe = GetModuleHandle(NULL); if (hExe == NULL) { die("GetModuleHandle failed"); } exePath = malloc(10000); // XXX GetModuleFileName(hExe, exePath, 10000); // XXX 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(10000); // XXX 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'; if (! SetEnvironmentVariable(TEXT("PATH"), path)) { printf("SetEnvironmentVariable failed (%d)\n", GetLastError()); } } 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 failed: %d: %s\n", 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; StgClosure *main_p; RtsConfig *rts_config_p; hs_main_t hs_main_p; setPath(); // hRtsDll = loadDll(TEXT("libHSrts_debug-ghc7.7.20130315.dll")); // hRtsDll = loadDll(TEXT("libHSrts_thr-ghc7.7.20130315.dll")); // hRtsDll = loadDll(TEXT("libHSrts-ghc7.7.20130315.dll")); hProgDll = loadDll(TEXT("ghc-stage2.exe.dll")); hRtsDll = GetNonNullModuleHandle(TEXT("libHSrts- ghc7.7.20130315.dll")); 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); } }}} Gives: {{{ Segmentation fault/access violation in generated code }}} -- Ticket URL: <http://hackage.haskell.org/trac/ghc/ticket/7772> GHC <http://www.haskell.org/ghc/> The Glasgow Haskell Compiler