driver/ghci/ghci.c

   1 /*
   2  *
   3  * $Id: ghci.c,v 1.10 2005/05/05 00:58:38 sof Exp $
   4  *
   5  * ghci wrapper for Win32 only
   6  *
   7  * This wrapper invokes ghc.exe with the added command-line
   8  *                option "--interactive".
   9  * (On Unix this is done by the ghci.sh shell script, but
  10  *  that does not work so well on Win32.)
  11  *
  12  * (c) The GHC Team 2001
  13  *
  14  * ghc.exe is searched for using the 'normal' search rules
  15  * for DLLs / EXEs (i.e., first in the same dir as this wrapper,
  16  * then system dirs, then PATH).
  17  *
  18  * To compile:
  19  *
  20  *   MSVC:    cl /o ghci.exe /c ghciwrap.c
  21  *   mingw:   gcc -mno-cygwin -o ghci.exe ghciwrap.c
  22  *
  23  * If you want to associate your own icon with the wrapper,
  24  * here's how to do it:
  25  *
  26  *   * Create a one-line .rc file, ghci.rc (say), containing
  27  *          0 ICON "hsicon.ico"
  28  *     (subst the string literal for the name of your icon file).
  29  *   * Compile it up (assuming the .ico file is in the same dir
  30  *     as the .rc file):
  31  *
  32  *         MSVC:    rc /i. /fo ghci.res ghci.rc
  33  *         mingw:   windres -o ghci.res -i ghci.rc -O coff
  34  *
  35  *   * Add the resulting .res file to the link line of the wrapper:
  36  *
  37  *     MSVC:    cl /o ghci.exe /c ghciwrap.c ghci.res
  38  *     mingw:   gcc -mno-cygwin -o ghci.exe ghciwrap.c ghci.res
  39  *
  40  */
  41
  42 #include <windows.h>
  43 #include <stdio.h>
  44 #include <process.h>
  45 #include <malloc.h>
  46 #include <stdlib.h>
  47 #include <signal.h>
  48 #include <io.h>
  49
  50 #define BINARY_NAME "ghc.exe"
  51 #define IACTIVE_OPTION "--interactive"
  52
  53 #define errmsg(msg) fprintf(stderr, msg "\n"); fflush(stderr)
  54 #define errmsg1(msg,val) fprintf(stderr, msg "\n",val); fflush(stderr)
  55
  56 int
  57 main(int argc, char** argv)
  58 {
  59   TCHAR  binPath[FILENAME_MAX+1];
  60   TCHAR  binPathShort[MAX_PATH+1];
  61   DWORD  dwSize = FILENAME_MAX;
  62   TCHAR* szEnd;
  63   int    i;
  64   char*  new_cmdline;
  65   char   *ptr, *src;
  66   unsigned int cmdline_len = 0;
  67   char **pp;
  68   LPTSTR pp1;
  69
  70   STARTUPINFO si;
  71   PROCESS_INFORMATION pi;
  72
  73   ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
  74   ZeroMemory(&si, sizeof(STARTUPINFO));
  75   si.cb = sizeof(STARTUPINFO);
  76
  77   if ( getenv("_") ) {
  78       printf("WARNING: GHCi invoked via 'ghci.exe' in *nix-like shells (cygwin-bash, in particular)\n");
  79       printf("         doesn't handle Ctrl-C well; use the 'ghcii.sh' shell wrapper instead\n");
  80       fflush(stdout);
  81   }
  82
  83   /* Locate the binary we want to start up */
  84   if ( !SearchPath(NULL,
  85                    BINARY_NAME,
  86                    NULL,
  87                    dwSize,
  88                    (char*)binPath,
  89                    &szEnd) ) {
  90     errmsg1("%s: Unable to locate ghc.exe", argv[0]);
  91     return 1;
  92   }
  93
  94   dwSize = MAX_PATH;
  95   /* Turn the path into short form - LFN form causes problems
  96      when passed in argv[0]. */
  97   if ( !(GetShortPathName(binPath, binPathShort, dwSize)) ) {
  98     errmsg1("%s: Unable to locate ghc.exe", argv[0]);
  99     return 1;
 100   }
 101
 102   /* Compute length of the flattened 'argv', including extra IACTIVE_OPTION (and spaces!) */
 103   cmdline_len += 1 + strlen(IACTIVE_OPTION);
 104   for(i=1;i<argc;i++) {
 105       /* Note: play it safe and quote all argv strings */
 106       cmdline_len += 1 + strlen(argv[i]) + 2;
 107   }
 108   new_cmdline = (char*)malloc(sizeof(char) * (cmdline_len + 1));
 109   if (!new_cmdline) {
 110       errmsg1("%s: failed to start up ghc.exe; insufficient memory", argv[0]);
 111       return 1;
 112   }
 113
 114   strcpy(new_cmdline, " " IACTIVE_OPTION);
 115   ptr = new_cmdline + strlen(" " IACTIVE_OPTION);
 116   for(i=1;i<argc;i++) {
 117       *ptr++ = ' ';
 118       *ptr++ = '"';
 119       src = argv[i];
 120       while(*src) {
 121           *ptr++ = *src++;
 122       }
 123       *ptr++ = '"';
 124   }
 125   *ptr = '\0';
 126
 127   /* Note: Used to use _spawnv(_P_WAIT, ...) here, but it suffered
 128      from the parent intercepting console events such as Ctrl-C,
 129      which it shouldn't. Installing an ignore-all console handler
 130      didn't do the trick either.
 131
 132      Irrespective of this issue, using CreateProcess() is preferable,
 133      as it makes this wrapper work on both mingw and cygwin.
 134   */
 135 #if 0
 136   fprintf(stderr, "Invoking ghc: %s %s\n", binPathShort, new_cmdline); fflush(stderr);
 137 #endif
 138   if (!CreateProcess(binPathShort,
 139                      new_cmdline,
 140                      NULL,
 141                      NULL,
 142                      TRUE,
 143                      0, /* dwCreationFlags */
 144                      NULL, /* lpEnvironment */
 145                      NULL, /* lpCurrentDirectory */
 146                      &si,  /* lpStartupInfo */
 147                      &pi) ) {
 148       errmsg1("Unable to start ghc.exe (error code: %lu)", GetLastError());
 149       return 1;
 150   }
 151   /* Disable handling of console events in the parent by dropping its
 152    * connection to the console. This has the (minor) downside of not being
 153    * able to subsequently emit any error messages to the console.
 154    */
 155   FreeConsole();
 156
 157   switch (WaitForSingleObject(pi.hProcess, INFINITE) ) {
 158   case WAIT_OBJECT_0:
 159       return 0;
 160   case WAIT_ABANDONED:
 161   case WAIT_FAILED:
 162       /* in the event we get any hard errors, bring the child to a halt. */
 163       TerminateProcess(pi.hProcess,1);
 164       return 1;
 165   default:
 166       return 1;
 167   }
 168 }