driver/ghc/ghc.c

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