ghci.c 4.67 KB
Newer Older
rrt's avatar
rrt committed
1
2
/*
 *
sof's avatar
sof committed
3
 * $Id: ghci.c,v 1.10 2005/05/05 00:58:38 sof Exp $
rrt's avatar
rrt committed
4
 *
5
6
7
 * ghci wrapper for Win32 only
 * 
 * This wrapper invokes ghc.exe with the added command-line
rrt's avatar
rrt committed
8
 *                option "--interactive".
9
10
 * (On Unix this is done by the ghci.sh shell script, but
 *  that does not work so well on Win32.)
rrt's avatar
rrt committed
11
12
13
14
15
16
17
18
19
20
 *
 * (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
21
 *   mingw:   gcc -o ghci.exe ghciwrap.c
rrt's avatar
rrt committed
22
23
24
25
26
27
28
29
30
31
 *
 * 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):
 *
sof's avatar
sof committed
32
 *         MSVC:    rc /i. /fo ghci.res ghci.rc 
sof's avatar
sof committed
33
 *         mingw:   windres -o ghci.res -i ghci.rc -O coff
rrt's avatar
rrt committed
34
35
36
37
 *
 *   * Add the resulting .res file to the link line of the wrapper:
 *
 *     MSVC:    cl /o ghci.exe /c ghciwrap.c ghci.res
38
 *     mingw:   gcc -o ghci.exe ghciwrap.c ghci.res
rrt's avatar
rrt committed
39
40
41
42
43
44
45
 *
 */

#include <windows.h>
#include <stdio.h>
#include <process.h>
#include <malloc.h>
sof's avatar
sof committed
46
#include <stdlib.h>
sof's avatar
sof committed
47
48
#include <signal.h>
#include <io.h>
rrt's avatar
rrt committed
49
50
51
52
53

#define BINARY_NAME "ghc.exe"
#define IACTIVE_OPTION "--interactive"

#define errmsg(msg) fprintf(stderr, msg "\n"); fflush(stderr)
sof's avatar
sof committed
54
#define errmsg1(msg,val) fprintf(stderr, msg "\n",val); fflush(stderr)
rrt's avatar
rrt committed
55
56
57
58
59

int
main(int argc, char** argv)
{
  TCHAR  binPath[FILENAME_MAX+1];
sof's avatar
sof committed
60
  TCHAR  binPathShort[MAX_PATH+1];
rrt's avatar
rrt committed
61
62
63
  DWORD  dwSize = FILENAME_MAX;
  TCHAR* szEnd;
  int    i;
sof's avatar
sof committed
64
65
66
67
68
69
  char*  new_cmdline;
  char   *ptr, *src;
  unsigned int cmdline_len = 0;

  STARTUPINFO si;
  PROCESS_INFORMATION pi;
sof's avatar
sof committed
70
  
sof's avatar
sof committed
71
72
73
74
  ZeroMemory(&pi, sizeof(PROCESS_INFORMATION));
  ZeroMemory(&si, sizeof(STARTUPINFO));
  si.cb = sizeof(STARTUPINFO);

sof's avatar
sof committed
75
76
77
78
79
80
  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);
  }

rrt's avatar
rrt committed
81
  /* Locate the binary we want to start up */
sof's avatar
sof committed
82
83
84
85
86
87
  if ( !SearchPath(NULL,
		   BINARY_NAME,
		   NULL,
		   dwSize,
		   (char*)binPath,
		   &szEnd) ) {
sof's avatar
sof committed
88
    errmsg1("%s: Unable to locate ghc.exe", argv[0]);
rrt's avatar
rrt committed
89
90
91
    return 1;
  }
  
sof's avatar
sof committed
92
93
94
95
  dwSize = MAX_PATH;
  /* Turn the path into short form - LFN form causes problems
     when passed in argv[0]. */
  if ( !(GetShortPathName(binPath, binPathShort, dwSize)) ) {
sof's avatar
sof committed
96
    errmsg1("%s: Unable to locate ghc.exe", argv[0]);
sof's avatar
sof committed
97
98
99
    return 1;
  }
  
sof's avatar
sof committed
100
101
102
103
104
  /* 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;
rrt's avatar
rrt committed
105
  }
sof's avatar
sof committed
106
107
  new_cmdline = (char*)malloc(sizeof(char) * (cmdline_len + 1));
  if (!new_cmdline) {
sof's avatar
sof committed
108
      errmsg1("%s: failed to start up ghc.exe; insufficient memory", argv[0]);
rrt's avatar
rrt committed
109
110
111
      return 1;
  }
  
sof's avatar
sof committed
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
  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.
rrt's avatar
rrt committed
129
     
sof's avatar
sof committed
130
131
     Irrespective of this issue, using CreateProcess() is preferable,
     as it makes this wrapper work on both mingw and cygwin.
rrt's avatar
rrt committed
132
  */
sof's avatar
sof committed
133
#if 0
sof's avatar
sof committed
134
  fprintf(stderr, "Invoking ghc: %s %s\n", binPathShort, new_cmdline); fflush(stderr);
sof's avatar
sof committed
135
#endif
sof's avatar
sof committed
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
  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;
  }
rrt's avatar
rrt committed
166
}