Don't install haskeline/mtl/terminfo, and hide ghc-binary
[ghc-hetmet.git] / 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
62   STARTUPINFO si;
63   PROCESS_INFORMATION pi;
64   
65   ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
66   ZeroMemory(&si, sizeof(STARTUPINFO));
67   si.cb = sizeof(STARTUPINFO);
68
69   /* Locate the binary we want to start up */
70   if ( !SearchPath(NULL,
71                    BINARY_NAME,
72                    NULL,
73                    dwSize,
74                    (char*)binPath,
75                    &szEnd) ) {
76     errmsg1("%s: Unable to locate ghc.exe", argv[0]);
77     return 1;
78   }
79   
80   dwSize = MAX_PATH;
81   /* Turn the path into short form - LFN form causes problems
82      when passed in argv[0]. */
83   if ( !(GetShortPathName(binPath, binPathShort, dwSize)) ) {
84     errmsg1("%s: Unable to locate ghc.exe", argv[0]);
85     return 1;
86   }
87   
88   /* Compute length of the flattened 'argv' */
89   for(i=1;i<argc;i++) {
90       /* Note: play it safe and quote all argv strings */
91       cmdline_len += 1 + strlen(argv[i]) + 2;
92   }
93   new_cmdline = (char*)malloc(sizeof(char) * (cmdline_len + 1));
94   if (!new_cmdline) {
95       errmsg1("%s: failed to start up ghc.exe; insufficient memory", argv[0]);
96       return 1;
97   }
98   
99   ptr = new_cmdline;
100   for(i=1;i<argc;i++) {
101       *ptr++ = ' ';
102       *ptr++ = '"';
103       src = argv[i];
104       while(*src) {
105           *ptr++ = *src++;
106       }
107       *ptr++ = '"';
108   }
109   *ptr = '\0';
110   
111   /* Note: Used to use _spawnv(_P_WAIT, ...) here, but it suffered
112      from the parent intercepting console events such as Ctrl-C,
113      which it shouldn't. Installing an ignore-all console handler
114      didn't do the trick either.
115      
116      Irrespective of this issue, using CreateProcess() is preferable,
117      as it makes this wrapper work on both mingw and cygwin.
118   */
119 #if 0
120   fprintf(stderr, "Invoking ghc: %s %s\n", binPathShort, new_cmdline); fflush(stderr);
121 #endif
122   if (!CreateProcess(binPathShort,
123                      new_cmdline,
124                      NULL,
125                      NULL,
126                      TRUE,
127                      0, /* dwCreationFlags */
128                      NULL, /* lpEnvironment */
129                      NULL, /* lpCurrentDirectory */
130                      &si,  /* lpStartupInfo */
131                      &pi) ) {
132       errmsg1("Unable to start ghc.exe (error code: %lu)", GetLastError());
133       return 1;
134   }
135   /* Disable handling of console events in the parent by dropping its
136    * connection to the console. This has the (minor) downside of not being
137    * able to subsequently emit any error messages to the console.
138    */
139   FreeConsole();
140
141   switch (WaitForSingleObject(pi.hProcess, INFINITE) ) {
142   case WAIT_OBJECT_0:
143       return 0;
144   case WAIT_ABANDONED:
145   case WAIT_FAILED:
146       /* in the event we get any hard errors, bring the child to a halt. */
147       TerminateProcess(pi.hProcess,1);
148       return 1;
149   default:
150       return 1;
151   }
152 }