From f97d36cd6e050a251ef421c902bcfa04200dcfd1 Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Thu, 18 Feb 2010 17:17:16 +0000
Subject: Use the shared C wrapper code in ghci.c too

---
 driver/ghci/ghc.mk |   3 +-
 driver/ghci/ghci.c | 176 ++++++-----------------------------------------------
 2 files changed, 20 insertions(+), 159 deletions(-)

(limited to 'driver/ghci')

diff --git a/driver/ghci/ghc.mk b/driver/ghci/ghc.mk
index eb4115f975..50512cc195 100644
--- a/driver/ghci/ghc.mk
+++ b/driver/ghci/ghc.mk
@@ -28,7 +28,8 @@ install_driver_ghci:
 
 else # Windows...
 
-driver/ghci_dist_C_SRCS  = ghci.c
+driver/ghci_dist_C_SRCS  = ghci.c ../utils/cwrapper.c ../utils/getLocation.c
+driver/ghci_dist_CC_OPTS += -I driver/utils
 driver/ghci_dist_PROG    = ghci$(exeext)
 driver/ghci_dist_INSTALL = YES
 driver/ghci_dist_OTHER_OBJS = driver/ghci/ghci.res
diff --git a/driver/ghci/ghci.c b/driver/ghci/ghci.c
index 97616d5432..03a8f98140 100644
--- a/driver/ghci/ghci.c
+++ b/driver/ghci/ghci.c
@@ -1,166 +1,26 @@
-/*
- *
- * $Id: ghci.c,v 1.10 2005/05/05 00:58:38 sof Exp $
- *
- * ghci wrapper for Win32 only
- * 
- * This wrapper invokes ghc.exe with the added command-line
- *                option "--interactive".
- * (On Unix this is done by the ghci.sh shell script, but
- *  that does not work so well on Win32.)
- *
- * (c) The GHC Team 2001
- *
- * ghc.exe is searched for using the 'normal' search rules
- * for DLLs / EXEs (i.e., first in the same dir as this wrapper,
- * then system dirs, then PATH).
- *
- * To compile:
- *
- *   MSVC:    cl /o ghci.exe /c ghciwrap.c
- *   mingw:   gcc -o ghci.exe ghciwrap.c
- *
- * If you want to associate your own icon with the wrapper,
- * here's how to do it:
- *
- *   * Create a one-line .rc file, ghci.rc (say), containing
- *          0 ICON "hsicon.ico"
- *     (subst the string literal for the name of your icon file).
- *   * Compile it up (assuming the .ico file is in the same dir
- *     as the .rc file):
- *
- *         MSVC:    rc /i. /fo ghci.res ghci.rc 
- *         mingw:   windres -o ghci.res -i ghci.rc -O coff
- *
- *   * Add the resulting .res file to the link line of the wrapper:
- *
- *     MSVC:    cl /o ghci.exe /c ghciwrap.c ghci.res
- *     mingw:   gcc -o ghci.exe ghciwrap.c ghci.res
- *
- */
 
-#include <windows.h>
-#include <stdio.h>
+#include "cwrapper.h"
+#include "getLocation.h"
+#include <errno.h>
 #include <process.h>
-#include <malloc.h>
+#include <stdio.h>
 #include <stdlib.h>
-#include <signal.h>
-#include <io.h>
-
-#define BINARY_NAME "ghc.exe"
-#define IACTIVE_OPTION "--interactive"
+#include <stdarg.h>
+#include <string.h>
 
-#define errmsg(msg) fprintf(stderr, msg "\n"); fflush(stderr)
-#define errmsg1(msg,val) fprintf(stderr, msg "\n",val); fflush(stderr)
+int main(int argc, char** argv) {
+    char *exePath;
+    char *preArgv[1];
 
-int
-main(int argc, char** argv)
-{
-  TCHAR  binPath[FILENAME_MAX+1];
-  TCHAR  binPathShort[MAX_PATH+1];
-  DWORD  dwSize = FILENAME_MAX;
-  TCHAR* szEnd;
-  int    i;
-  char*  new_cmdline;
-  char   *ptr, *src;
-  unsigned int cmdline_len = 0;
+    if (getenv("_")) {
+        printf("WARNING: GHCi invoked via 'ghci.exe' in *nix-like shells (cygwin-bash, in particular)\n");
+        printf("         doesn't handle Ctrl-C well; use the 'ghcii.sh' shell wrapper instead\n");
+        fflush(stdout);
+    }
 
-  STARTUPINFO si;
-  PROCESS_INFORMATION pi;
-  
-  ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
-  ZeroMemory(&si, sizeof(STARTUPINFO));
-  si.cb = sizeof(STARTUPINFO);
+    exePath = "ghc.exe";
+    preArgv[0] = "--interactive";
 
-  if ( getenv("_") ) {
-      printf("WARNING: GHCi invoked via 'ghci.exe' in *nix-like shells (cygwin-bash, in particular)\n");
-      printf("         doesn't handle Ctrl-C well; use the 'ghcii.sh' shell wrapper instead\n");
-      fflush(stdout);
-  }
-
-  /* Locate the binary we want to start up */
-  if ( !SearchPath(NULL,
-		   BINARY_NAME,
-		   NULL,
-		   dwSize,
-		   (char*)binPath,
-		   &szEnd) ) {
-    errmsg1("%s: Unable to locate ghc.exe", argv[0]);
-    return 1;
-  }
-  
-  dwSize = MAX_PATH;
-  /* Turn the path into short form - LFN form causes problems
-     when passed in argv[0]. */
-  if ( !(GetShortPathName(binPath, binPathShort, dwSize)) ) {
-    errmsg1("%s: Unable to locate ghc.exe", argv[0]);
-    return 1;
-  }
-  
-  /* Compute length of the flattened 'argv', including extra IACTIVE_OPTION (and spaces!) */
-  cmdline_len += 1 + strlen(IACTIVE_OPTION);
-  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) {
-      errmsg1("%s: failed to start up ghc.exe; insufficient memory", argv[0]);
-      return 1;
-  }
-  
-  strcpy(new_cmdline, " " IACTIVE_OPTION);
-  ptr = new_cmdline + strlen(" " IACTIVE_OPTION);
-  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", binPathShort, new_cmdline); fflush(stderr);
-#endif
-  if (!CreateProcess(binPathShort,
-		     new_cmdline,
-		     NULL,
-		     NULL,
-		     TRUE,
-		     0, /* dwCreationFlags */
-		     NULL, /* lpEnvironment */
-		     NULL, /* lpCurrentDirectory */
-		     &si,  /* lpStartupInfo */
-		     &pi) ) {
-      errmsg1("Unable to start ghc.exe (error code: %lu)", 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:
-      return 0;
-  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;
-  }
+    run(exePath, 1, preArgv, argc - 1, argv + 1);
 }
+
-- 
cgit v1.2.1