1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
/*
*
* $Id: ghci.c,v 1.10 2005/05/05 00:58:38 sof Exp $
*
* 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
*
* ghc.exe is searched for using the 'normal' search rules
* for DLLs / EXEs (i.e., first in the same dir as this wrapper,
* then system dirs, then PATH).
*
* To compile:
*
* MSVC: cl /o ghci.exe /c ghciwrap.c
* mingw: gcc -mno-cygwin -o ghci.exe ghciwrap.c
*
* If you want to associate your own icon with the wrapper,
* here's how to do it:
*
* * Create a one-line .rc file, ghci.rc (say), containing
* 0 ICON "hsicon.ico"
* (subst the string literal for the name of your icon file).
* * Compile it up (assuming the .ico file is in the same dir
* as the .rc file):
*
* 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:
*
* MSVC: cl /o ghci.exe /c ghciwrap.c ghci.res
* mingw: gcc -mno-cygwin -o ghci.exe ghciwrap.c ghci.res
*
*/
#include <windows.h>
#include <stdio.h>
#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;
TCHAR* szEnd;
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 */
if ( !SearchPath(NULL,
BINARY_NAME,
NULL,
dwSize,
(char*)binPath,
&szEnd) ) {
errmsg1("%s: Unable to locate ghc.exe", argv[0]);
return 1;
}
dwSize = MAX_PATH;
/* Turn the path into short form - LFN form causes problems
when passed in argv[0]. */
if ( !(GetShortPathName(binPath, binPathShort, dwSize)) ) {
errmsg1("%s: Unable to locate ghc.exe", argv[0]);
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_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;
}
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.
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: %s %s\n", binPathShort, new_cmdline); fflush(stderr);
#endif
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;
}
}
|
