/*
*
- * $Id: ghci.c,v 1.4 2001/10/10 17:25:15 sof Exp $
+ * $Id: ghci.c,v 1.10 2005/05/05 00:58:38 sof Exp $
*
- * ghci wrapper - invokes ghc.exe with the added command-line
+ * 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
*
* * Compile it up (assuming the .ico file is in the same dir
* as the .rc file):
*
- * MSVC: rc /I. ghci.rc /o ghci.res
+ * 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:
#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;
- DWORD dwRes;
TCHAR* szEnd;
- char** new_argv;
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 */
- dwRes =
- SearchPath(NULL,
- BINARY_NAME,
- NULL,
- dwSize,
- (char*)binPath,
- &szEnd);
-
- if (dwRes == 0) {
- errmsg("Unable to locate ghc.exe");
+ if ( !SearchPath(NULL,
+ BINARY_NAME,
+ NULL,
+ dwSize,
+ (char*)binPath,
+ &szEnd) ) {
+ errmsg1("%s: Unable to locate ghc.exe", argv[0]);
return 1;
}
/* Turn the path into short form - LFN form causes problems
when passed in argv[0]. */
if ( !(GetShortPathName(binPath, binPathShort, dwSize)) ) {
- errmsg("Unable to locate ghc.exe");
+ errmsg1("%s: Unable to locate ghc.exe", argv[0]);
return 1;
}
- new_argv = (char**)malloc(sizeof(char*) * (argc + 1 + 1));
- if (new_argv == NULL) {
- errmsg("failed to start up ghc.exe");
- 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_argv[0] = binPathShort;
-
- new_argv[1] = (char*)malloc(sizeof(char) * (strlen(IACTIVE_OPTION) + 1));
- if (new_argv[1]) {
- strcpy(new_argv[1], IACTIVE_OPTION);
- } else {
- errmsg("failed to start up ghc.exe");
- return 1;
- }
-
- for ( i=1; i < argc; i++ ) {
- new_argv[i+1] = (char*)malloc(sizeof(char) * (strlen(argv[i]) + 1));
- if (new_argv[i+1] == NULL) {
- errmsg("failed to start up ghc.exe");
+ 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;
- } else {
- strcpy(new_argv[i+1], argv[i]);
- }
}
- new_argv[i+1] = NULL;
- /* I was hoping to be able to use execv() here, but
- the MS implementation of said function doesn't appear to
- be quite right (the 'parent' app seems to exit without
- waiting, which is not a spec-fulfilling thing to do).
-
- Cygwin gives me the right behaviour, but does it by
- implementing it in terms of spawnv(), so you pay
- the cost of having to create an extra process.
+ 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.
- ==> Just use spawnv().
+ 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: ");
- i=0;
- while (new_argv[i] != NULL) {
- fprintf(stderr, "%s ", new_argv[i++]);
- }
- fprintf(stderr, "\n"); fflush(stderr);
+ fprintf(stderr, "Invoking ghc: %s %s\n", binPathShort, new_cmdline); fflush(stderr);
#endif
- return _spawnv(_P_WAIT, binPath, new_argv);
+ 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;
+ }
}
projects / ghc-hetmet.git / blobdiff