X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fghc-inplace.c;h=8cddc898a5e7f8a3f04efbf96616c797c7c3d6c3;hp=d7599ea2f86a1c6520477bd3540112f3bbe002cc;hb=235edf36cc202bb21c00d0e5e05ebf076fb0542e;hpb=9c5a3913f8dec019875b03ce6dce370b7e9920de

diff --git a/compiler/ghc-inplace.c b/compiler/ghc-inplace.c
index d7599ea..8cddc89 100644
--- a/compiler/ghc-inplace.c
+++ b/compiler/ghc-inplace.c
@@ -1,156 +1,29 @@
-
 #include <stdio.h>
 #include <stdarg.h>
 #include <stdlib.h>
 #include <string.h>
 #include <unistd.h>
-
-#ifdef WINDOWS
-#include <windows.h>
-#include <process.h>
-#include <malloc.h>
-#include <signal.h>
-#include <io.h>
-#endif
-
-int run(char *this, char *program, int argc, char **argv);
-
-void error(const char *fmt, ...) {
-    va_list argp;
-    va_start(argp, fmt);
-    vfprintf(stderr, fmt, argp);
-    va_end(argp);
-    fprintf(stderr, "\n");
-    fflush(stderr);
-}
+#include <shell-tools.c>
 
 int main(int argc, char **argv) {
     char **args;
-    args = malloc(sizeof(char *) * (argc + 3));
+    args = malloc(sizeof(char *) * (argc + 4));
     if (args == NULL) {
         fprintf(stderr, "Malloc failed\n");
         exit(1);
     }
     args[0] = "GHC_PATH"; /* Gets replaced by sed */
     args[1] = "-BTOP_ABS"; /* Gets replaced by sed */
-    args[2] = "-fhardwire-lib-paths";
+    args[2] = "-dynload";
+    args[3] = "wrapped";
     if ((argc >= 2) && (strcmp(argv[1], "-v") == 0)) {
-        printf("Using %s %s %s\n", args[0], args[1], args[2]);
+        printf("Using %s %s %s %s\n", args[0], args[1], args[2], args[3]);
         fflush(stdout);
     }
-    memcpy(args + 3, argv + 1, sizeof(char *) * (argc - 1));
-    args[argc+2] = NULL;
+    memcpy(args + 4, argv + 1, sizeof(char *) * (argc - 1));
+    args[argc+3] = NULL;
     return run(argv[0],
                "GHC_PATH", /* Gets replaced by sed */
-               argc + 2,
+               argc + 3,
                args);
 }
-
-#ifndef WINDOWS
-int run(char *this, char *program, int argc, char** argv) {
-    execv(program, argv);
-    return 1; /* Not reached */
-}
-#else
-int run(char *this, char *program, int argc, char** argv) {
-    TCHAR  programShort[MAX_PATH+1];
-    DWORD  dwSize;
-    DWORD  dwExitCode;
-    int    i;
-    char*  new_cmdline;
-    char   *ptr;
-    char   *src;
-    unsigned int cmdline_len;
-
-    STARTUPINFO si;
-    PROCESS_INFORMATION pi;
-  
-    ZeroMemory(&si, sizeof(STARTUPINFO));
-    ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
-
-    si.cb = sizeof(STARTUPINFO);
-
-    dwSize = MAX_PATH;
-    /* Turn the path into short form - LFN form causes problems
-       when passed in argv[0]. */
-    if ( !(GetShortPathName(program, programShort, dwSize)) ) {
-        error("%s: Unable to locate %s", this, program);
-        return 1;
-    }
-  
-    /* Compute length of the flattened 'argv', including spaces! */
-    cmdline_len = 0;
-    for(i = 1; i < argc; i++) {
-        /* Note: play it safe and quote all argv strings */
-        cmdline_len += 1 + strlen(argv[i]) + 2;
-    }
-    new_cmdline = (char*)malloc(sizeof(char) * (cmdline_len + 1));
-    if (!new_cmdline) {
-        error("%s: failed to start up ghc.exe; insufficient memory", this);
-        return 1;
-    }
-  
-    ptr = new_cmdline;
-    for(i = 1; i < argc; i++) {
-        *ptr++ = ' ';
-        *ptr++ = '"';
-        src = argv[i];
-        while(*src) {
-            *ptr++ = *src++;
-        }
-        *ptr++ = '"';
-    }
-    *ptr = '\0';
-  
-    /* Note: Used to use _spawnv(_P_WAIT, ...) here, but it suffered
-       from the parent intercepting console events such as Ctrl-C,
-       which it shouldn't. Installing an ignore-all console handler
-       didn't do the trick either.
-
-       Irrespective of this issue, using CreateProcess() is preferable,
-       as it makes this wrapper work on both mingw and cygwin.
-    */
-#if 0
-    fprintf(stderr, "Invoking ghc: %s %s\n", programShort, new_cmdline);
-    fflush(stderr);
-#endif
-    if (!CreateProcess(programShort,
-                       new_cmdline,
-                       NULL,
-                       NULL,
-                       TRUE,
-                       0, /* dwCreationFlags */
-                       NULL, /* lpEnvironment */
-                       NULL, /* lpCurrentDirectory */
-                       &si,  /* lpStartupInfo */
-                       &pi) ) {
-        error("%s: Unable to start ghc.exe (error code: %lu)",
-              this, GetLastError());
-        return 1;
-    }
-    /* Disable handling of console events in the parent by dropping its
-     * connection to the console. This has the (minor) downside of not being
-     * able to subsequently emit any error messages to the console.
-     */
-    FreeConsole();
-
-    switch (WaitForSingleObject(pi.hProcess, INFINITE) ) {
-        case WAIT_OBJECT_0:
-            if (GetExitCodeProcess(pi.hProcess, &dwExitCode)) {
-                return dwExitCode;
-            }
-            else {
-                return 1;
-            }
-        case WAIT_ABANDONED:
-        case WAIT_FAILED:
-            /* in the event we get any hard errors, bring the child
-               to a halt. */
-            TerminateProcess(pi.hProcess, 1);
-            return 1;
-        default:
-            return 1;
-    }
-}
-#endif
-