/*
*
- * $Id: ghci.c,v 1.8 2003/06/12 09:48:17 simonpj Exp $
+ * $Id: ghci.c,v 1.9 2005/04/22 17:15:51 sof Exp $
*
* ghci wrapper for Win32 only
*
#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);
+
/* Locate the binary we want to start up */
- dwRes =
- SearchPath(NULL,
- BINARY_NAME,
- NULL,
- dwSize,
- (char*)binPath,
- &szEnd);
-
- if (dwRes == 0) {
+ if ( !SearchPath(NULL,
+ BINARY_NAME,
+ NULL,
+ dwSize,
+ (char*)binPath,
+ &szEnd) ) {
errmsg("Unable to locate ghc.exe");
return 1;
}
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++ ) {
- int len = strlen(argv[i]);
- /* to avoid quoting issues, surround each option in double quotes */
- new_argv[i+1] = (char*)malloc(sizeof(char) * (len + 3));
- 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) {
+ errmsg("failed to start up ghc.exe; insufficient memory");
return 1;
- } else {
- new_argv[i+1][0] = '"';
- strcpy(1 + new_argv[i+1], argv[i]);
- new_argv[i+1][len+1] = '"';
- new_argv[i+1][len+2] = '\0';
- }
}
- 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.
- Plus, of course, we aren't allowed to use Cygwin here, because
- GHC does not assume Cygwin.
+ 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(), which is provided by msvcrt.dll, the
- Microsoft C runtime to which mingw delegates almost all
- system calls
-
- [Sigbjorn adds 12 Jun 03]
- We probably ought to use CreateProcess() in ghci.c -- or better still an exec()-like
- that didn't have to create a separate process from the wrapper (which is what that
- code comment in there is driving at.)
-
- CreateProcess() is a more wieldy function to invoke, which is probably why
- I opted for spawnv(). spawnv() performs the equivalent of Prelude.unwords
- (to look at the code itself, or at least an older version, see dospawn.c in the
- vc98/crt/src/ directory of an MSVC6 installation.)
-
- CreateProcess() is a native Win32 API though, which has the merit that it is
- guaranteed to work the same with both the mingw and cygwin ports.
+ 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 / commitdiff