diff options
Diffstat (limited to 'driver/ghci')
| -rw-r--r-- | driver/ghci/Makefile | 69 | ||||
| -rw-r--r-- | driver/ghci/ghci.c | 168 | ||||
| -rw-r--r-- | driver/ghci/ghci.ico | bin | 0 -> 766 bytes | |||
| -rw-r--r-- | driver/ghci/ghci.rc | 1 | ||||
| -rw-r--r-- | driver/ghci/ghci.sh | 2 | ||||
| -rw-r--r-- | driver/ghci/ghcii.sh | 3 |
6 files changed, 243 insertions, 0 deletions
diff --git a/driver/ghci/Makefile b/driver/ghci/Makefile new file mode 100644 index 0000000000..7c67ac546c --- /dev/null +++ b/driver/ghci/Makefile @@ -0,0 +1,69 @@ +#----------------------------------------------------------------------------- +# $Id: Makefile,v 1.11 2005/05/05 00:58:38 sof Exp $ +# + +TOP=../.. +include $(TOP)/mk/boilerplate.mk + +# hack for ghci-inplace script, see below +INSTALLING=1 + +# ----------------------------------------------------------------------------- +# ghci script + +ifeq "$(INSTALLING)" "1" +ifeq "$(BIN_DIST)" "1" +GHCBIN=$$\"\"libexecdir/ghc-$(ProjectVersion) +GHCLIB=$$\"\"libdir +else +GHCBIN=$(libexecdir)/ghc-$(ProjectVersion) +GHCLIB=$(libdir) +endif # BIN_DIST +else +GHCBIN=$(FPTOOLS_TOP_ABS)/$(GHC_COMPILER_DIR_REL)/ghc-$(ProjectVersion) +GHCLIB=$(FPTOOLS_TOP_ABS) +endif + +INSTALLED_SCRIPT_PROG = ghci-$(ProjectVersion) +INPLACE_SCRIPT_PROG = ghci-inplace + +ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" +C_PROG = ghci +C_OBJS += ghci.res +else +C_SRCS= +endif + +SCRIPT_OBJS = ghci.sh +INTERP = $(SHELL) +SCRIPT_SUBST_VARS = GHCBIN TOPDIROPT +ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32" +INSTALL_SCRIPTS += $(SCRIPT_PROG) +else +INSTALL_SCRIPTS += ghcii.sh +INSTALL_PROGS += $(C_PROG) +endif +TOPDIROPT = -B$(GHCLIB) + +ifeq "$(INSTALLING)" "1" +SCRIPT_PROG = $(INSTALLED_SCRIPT_PROG) +ifneq "$(TARGETPLATFORM)" "i386-unknown-mingw32" +LINK = ghci +endif +else +SCRIPT_PROG = $(INPLACE_SCRIPT_PROG) +endif + +# don't recurse on 'make install' +# +ifeq "$(INSTALLING)" "1" +all clean distclean maintainer-clean :: + $(MAKE) INSTALLING=0 BIN_DIST=0 $(MFLAGS) $@ +endif + +ifeq "$(TARGETPLATFORM)" "i386-unknown-mingw32" +ghci.res : ghci.rc ghci.ico + windres -o ghci.res -i ghci.rc -O coff +endif + +include $(TOP)/mk/target.mk diff --git a/driver/ghci/ghci.c b/driver/ghci/ghci.c new file mode 100644 index 0000000000..f21a12a4ba --- /dev/null +++ b/driver/ghci/ghci.c @@ -0,0 +1,168 @@ +/* + * + * $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 -mno-cygwin -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 -mno-cygwin -o ghci.exe ghciwrap.c ghci.res + * + */ + +#include <windows.h> +#include <stdio.h> +#include <process.h> +#include <malloc.h> +#include <stdlib.h> +#include <signal.h> +#include <io.h> + +#define BINARY_NAME "ghc.exe" +#define IACTIVE_OPTION "--interactive" + +#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) +{ + 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; + char **pp; + LPTSTR pp1; + + STARTUPINFO si; + PROCESS_INFORMATION pi; + + ZeroMemory(&pi, sizeof(PROCESS_INFORMATION)); + ZeroMemory(&si, sizeof(STARTUPINFO)); + si.cb = sizeof(STARTUPINFO); + + 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; + } +} diff --git a/driver/ghci/ghci.ico b/driver/ghci/ghci.ico Binary files differnew file mode 100644 index 0000000000..680be76e71 --- /dev/null +++ b/driver/ghci/ghci.ico diff --git a/driver/ghci/ghci.rc b/driver/ghci/ghci.rc new file mode 100644 index 0000000000..01ed2f4081 --- /dev/null +++ b/driver/ghci/ghci.rc @@ -0,0 +1 @@ +0 ICON "ghci.ico" diff --git a/driver/ghci/ghci.sh b/driver/ghci/ghci.sh new file mode 100644 index 0000000000..b0200477b8 --- /dev/null +++ b/driver/ghci/ghci.sh @@ -0,0 +1,2 @@ +# Mini-driver for GHCi +exec $GHCBIN $TOPDIROPT --interactive ${1+"$@"} diff --git a/driver/ghci/ghcii.sh b/driver/ghci/ghcii.sh new file mode 100644 index 0000000000..70d98988b8 --- /dev/null +++ b/driver/ghci/ghcii.sh @@ -0,0 +1,3 @@ +#!/bin/sh +# Mini-driver for GHCi +exec $0/../ghc --interactive ${1+"$@"} |