16 int run(char *this, char *program, int argc, char **argv);
18 void error(const char *fmt, ...) {
21 vfprintf(stderr, fmt, argp);
23 fprintf(stderr, "\n");
27 int main(int argc, char **argv) {
29 args = malloc(sizeof(char *) * (argc + 3));
31 fprintf(stderr, "Malloc failed\n");
34 args[0] = "GHC_PATH"; /* Gets replaced by sed */
35 args[1] = "-BTOP_ABS"; /* Gets replaced by sed */
36 args[2] = "-fhardwire-lib-paths";
37 if ((argc >= 2) && (strcmp(argv[1], "-v") == 0)) {
38 printf("Using %s %s %s\n", args[0], args[1], args[2]);
41 memcpy(args + 3, argv + 1, sizeof(char *) * (argc - 1));
44 "GHC_PATH", /* Gets replaced by sed */
50 int run(char *this, char *program, int argc, char** argv) {
52 return 1; /* Not reached */
55 int run(char *this, char *program, int argc, char** argv) {
56 TCHAR programShort[MAX_PATH+1];
63 unsigned int cmdline_len;
66 PROCESS_INFORMATION pi;
68 ZeroMemory(&si, sizeof(STARTUPINFO));
69 ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
71 si.cb = sizeof(STARTUPINFO);
74 /* Turn the path into short form - LFN form causes problems
75 when passed in argv[0]. */
76 if ( !(GetShortPathName(program, programShort, dwSize)) ) {
77 error("%s: Unable to locate %s", this, program);
81 /* Compute length of the flattened 'argv', including spaces! */
83 for(i = 1; i < argc; i++) {
84 /* Note: play it safe and quote all argv strings */
85 cmdline_len += 1 + strlen(argv[i]) + 2;
87 new_cmdline = (char*)malloc(sizeof(char) * (cmdline_len + 1));
89 error("%s: failed to start up ghc.exe; insufficient memory", this);
94 for(i = 1; i < argc; i++) {
105 /* Note: Used to use _spawnv(_P_WAIT, ...) here, but it suffered
106 from the parent intercepting console events such as Ctrl-C,
107 which it shouldn't. Installing an ignore-all console handler
108 didn't do the trick either.
110 Irrespective of this issue, using CreateProcess() is preferable,
111 as it makes this wrapper work on both mingw and cygwin.
114 fprintf(stderr, "Invoking ghc: %s %s\n", programShort, new_cmdline);
117 if (!CreateProcess(programShort,
122 0, /* dwCreationFlags */
123 NULL, /* lpEnvironment */
124 NULL, /* lpCurrentDirectory */
125 &si, /* lpStartupInfo */
127 error("%s: Unable to start ghc.exe (error code: %lu)",
128 this, GetLastError());
131 /* Disable handling of console events in the parent by dropping its
132 * connection to the console. This has the (minor) downside of not being
133 * able to subsequently emit any error messages to the console.
137 switch (WaitForSingleObject(pi.hProcess, INFINITE) ) {
139 if (GetExitCodeProcess(pi.hProcess, &dwExitCode)) {
147 /* in the event we get any hard errors, bring the child
149 TerminateProcess(pi.hProcess, 1);