add sysErrorBelch() for reporting system call errors
[ghc.git] / rts / RtsMessages.c
1 /* -----------------------------------------------------------------------------
2 *
3 * (c) The GHC Team, 1998-2004
4 *
5 * General utility functions used in the RTS.
6 *
7 * ---------------------------------------------------------------------------*/
8
9 #include "PosixSource.h"
10 #include "Rts.h"
11
12 #include <stdio.h>
13
14 #ifdef HAVE_WINDOWS_H
15 #include <windows.h>
16 #endif
17
18 /* -----------------------------------------------------------------------------
19 General message generation functions
20
21 All messages should go through here. We can't guarantee that
22 stdout/stderr will be available - e.g. in a Windows program there
23 is no console for generating messages, so they have to either go to
24 to the debug console, or pop up message boxes.
25 -------------------------------------------------------------------------- */
26
27 // Default to the stdio implementation of these hooks.
28 RtsMsgFunction *fatalInternalErrorFn = rtsFatalInternalErrorFn;
29 RtsMsgFunction *debugMsgFn = rtsDebugMsgFn;
30 RtsMsgFunction *errorMsgFn = rtsErrorMsgFn;
31 RtsMsgFunction *sysErrorMsgFn = rtsSysErrorMsgFn;
32
33 void
34 barf(const char*s, ...)
35 {
36 va_list ap;
37 va_start(ap,s);
38 (*fatalInternalErrorFn)(s,ap);
39 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
40 va_end(ap);
41 }
42
43 void
44 vbarf(const char*s, va_list ap)
45 {
46 (*fatalInternalErrorFn)(s,ap);
47 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
48 }
49
50 void
51 _assertFail(const char*filename, unsigned int linenum)
52 {
53 barf("ASSERTION FAILED: file %s, line %u\n", filename, linenum);
54 }
55
56 void
57 errorBelch(const char*s, ...)
58 {
59 va_list ap;
60 va_start(ap,s);
61 (*errorMsgFn)(s,ap);
62 va_end(ap);
63 }
64
65 void
66 verrorBelch(const char*s, va_list ap)
67 {
68 (*errorMsgFn)(s,ap);
69 }
70
71 void
72 sysErrorBelch(const char*s, ...)
73 {
74 va_list ap;
75 va_start(ap,s);
76 (*sysErrorMsgFn)(s,ap);
77 va_end(ap);
78 }
79
80 void
81 vsysErrorBelch(const char*s, va_list ap)
82 {
83 (*sysErrorMsgFn)(s,ap);
84 }
85
86 void
87 debugBelch(const char*s, ...)
88 {
89 va_list ap;
90 va_start(ap,s);
91 (*debugMsgFn)(s,ap);
92 va_end(ap);
93 }
94
95 void
96 vdebugBelch(const char*s, va_list ap)
97 {
98 (*debugMsgFn)(s,ap);
99 }
100
101 /* -----------------------------------------------------------------------------
102 stdio versions of the message functions
103 -------------------------------------------------------------------------- */
104
105 #define BUFSIZE 512
106
107 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
108 static int
109 isGUIApp(void)
110 {
111 PIMAGE_DOS_HEADER pDOSHeader;
112 PIMAGE_NT_HEADERS pPEHeader;
113
114 pDOSHeader = (PIMAGE_DOS_HEADER) GetModuleHandleA(NULL);
115 if (pDOSHeader->e_magic != IMAGE_DOS_SIGNATURE)
116 return 0;
117
118 pPEHeader = (PIMAGE_NT_HEADERS) ((char *)pDOSHeader + pDOSHeader->e_lfanew);
119 if (pPEHeader->Signature != IMAGE_NT_SIGNATURE)
120 return 0;
121
122 return (pPEHeader->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
123 }
124 #endif
125
126 #define xstr(s) str(s)
127 #define str(s) #s
128
129 void
130 rtsFatalInternalErrorFn(const char *s, va_list ap)
131 {
132 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
133 if (isGUIApp())
134 {
135 char title[BUFSIZE], message[BUFSIZE];
136
137 snprintf(title, BUFSIZE, "%s: internal error", prog_name);
138 vsnprintf(message, BUFSIZE, s, ap);
139
140 MessageBox(NULL /* hWnd */,
141 message,
142 title,
143 MB_OK | MB_ICONERROR | MB_TASKMODAL
144 );
145 }
146 else
147 #endif
148 {
149 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
150 if (prog_argv != NULL && prog_name != NULL) {
151 fprintf(stderr, "%s: internal error: ", prog_name);
152 } else {
153 fprintf(stderr, "internal error: ");
154 }
155 vfprintf(stderr, s, ap);
156 fprintf(stderr, "\n");
157 fprintf(stderr, " (GHC version %s for %s)\n", ProjectVersion, xstr(HostPlatform_TYPE));
158 fprintf(stderr, " Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n");
159 fflush(stderr);
160 }
161
162 abort();
163 // stg_exit(EXIT_INTERNAL_ERROR);
164 }
165
166 void
167 rtsErrorMsgFn(const char *s, va_list ap)
168 {
169 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
170 if (isGUIApp())
171 {
172 char buf[BUFSIZE];
173 int r;
174
175 r = vsnprintf(buf, BUFSIZE, s, ap);
176 if (r > 0 && r < BUFSIZE) {
177 MessageBox(NULL /* hWnd */,
178 buf,
179 prog_name,
180 MB_OK | MB_ICONERROR | MB_TASKMODAL
181 );
182 }
183 }
184 else
185 #endif
186 {
187 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
188 if (prog_argv != NULL && prog_name != NULL) {
189 fprintf(stderr, "%s: ", prog_name);
190 }
191 vfprintf(stderr, s, ap);
192 fprintf(stderr, "\n");
193 }
194 }
195
196 void
197 rtsSysErrorMsgFn(const char *s, va_list ap)
198 {
199 char *syserr;
200
201 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
202 FormatMessage(
203 FORMAT_MESSAGE_ALLOCATE_BUFFER |
204 FORMAT_MESSAGE_FROM_SYSTEM |
205 FORMAT_MESSAGE_IGNORE_INSERTS,
206 NULL,
207 GetLastError(),
208 MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
209 (LPTSTR) &syserr,
210 0,
211 NULL );
212
213 if (isGUIApp())
214 {
215 char buf[BUFSIZE];
216 int r;
217
218 r = vsnprintf(buf, BUFSIZE, s, ap);
219 if (r > 0 && r < BUFSIZE) {
220 r = vsnprintf(buf+r, BUFSIZE-r, ": %s", syserr);
221 MessageBox(NULL /* hWnd */,
222 buf,
223 prog_name,
224 MB_OK | MB_ICONERROR | MB_TASKMODAL
225 );
226 }
227 }
228 else
229 #else
230 syserr = strerror(errno);
231 // ToDo: use strerror_r() if available
232 #endif
233 {
234 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
235 if (prog_argv != NULL && prog_name != NULL) {
236 fprintf(stderr, "%s: ", prog_name);
237 }
238 vfprintf(stderr, s, ap);
239 if (syserr) {
240 fprintf(stderr, ": %s\n", syserr);
241 } else {
242 fprintf(stderr, "\n");
243 }
244 }
245
246 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
247 if (syserr) LocalFree(syserr);
248 #endif
249 }
250
251 void
252 rtsDebugMsgFn(const char *s, va_list ap)
253 {
254 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
255 if (isGUIApp())
256 {
257 char buf[BUFSIZE];
258 int r;
259
260 r = vsnprintf(buf, BUFSIZE, s, ap);
261 if (r > 0 && r < BUFSIZE) {
262 OutputDebugString(buf);
263 }
264 }
265 else
266 #endif
267 {
268 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
269 vfprintf(stderr, s, ap);
270 fflush(stderr);
271 }
272 }