diff options
author | Ian Lynagh <igloo@earth.li> | 2010-02-18 17:17:16 +0000 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2010-02-18 17:17:16 +0000 |
commit | f97d36cd6e050a251ef421c902bcfa04200dcfd1 (patch) | |
tree | 4802ad80d3ed4569ad9fa38612a6a01f4cd4d069 /driver/ghci | |
parent | dc5b9bd64d1c1f544e4813dc946b5a83ad304cee (diff) | |
download | haskell-f97d36cd6e050a251ef421c902bcfa04200dcfd1.tar.gz |
Use the shared C wrapper code in ghci.c too
Diffstat (limited to 'driver/ghci')
-rw-r--r-- | driver/ghci/ghc.mk | 3 | ||||
-rw-r--r-- | driver/ghci/ghci.c | 176 |
2 files changed, 20 insertions, 159 deletions
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); } + |