Fix README
[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 "eventlog/EventLog.h"
13
14 #if USE_LIBDW
15 #include <Libdw.h>
16 #endif
17
18 #include <stdio.h>
19 #include <string.h>
20 #include <errno.h>
21
22 #if defined(HAVE_WINDOWS_H)
23 #include <windows.h>
24 #include <fcntl.h>
25 #endif
26
27 /* -----------------------------------------------------------------------------
28 General message generation functions
29
30 All messages should go through here. We can't guarantee that
31 stdout/stderr will be available - e.g. in a Windows program there
32 is no console for generating messages, so they have to either go to
33 to the debug console, or pop up message boxes.
34 -------------------------------------------------------------------------- */
35
36 // Default to the stdio implementation of these hooks.
37 RtsMsgFunction *fatalInternalErrorFn = rtsFatalInternalErrorFn;
38 RtsMsgFunction *debugMsgFn = rtsDebugMsgFn;
39 RtsMsgFunction *errorMsgFn = rtsErrorMsgFn;
40 RtsMsgFunction *sysErrorMsgFn = rtsSysErrorMsgFn;
41
42 void
43 barf(const char*s, ...)
44 {
45 va_list ap;
46 va_start(ap,s);
47 (*fatalInternalErrorFn)(s,ap);
48 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
49 va_end(ap);
50 }
51
52 void
53 vbarf(const char*s, va_list ap)
54 {
55 (*fatalInternalErrorFn)(s,ap);
56 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
57 }
58
59 void
60 _assertFail(const char*filename, unsigned int linenum)
61 {
62 barf("ASSERTION FAILED: file %s, line %u\n", filename, linenum);
63 }
64
65 void
66 errorBelch(const char*s, ...)
67 {
68 va_list ap;
69 va_start(ap,s);
70 (*errorMsgFn)(s,ap);
71 va_end(ap);
72 }
73
74 void
75 verrorBelch(const char*s, va_list ap)
76 {
77 (*errorMsgFn)(s,ap);
78 }
79
80 void
81 sysErrorBelch(const char*s, ...)
82 {
83 va_list ap;
84 va_start(ap,s);
85 (*sysErrorMsgFn)(s,ap);
86 va_end(ap);
87 }
88
89 void
90 vsysErrorBelch(const char*s, va_list ap)
91 {
92 (*sysErrorMsgFn)(s,ap);
93 }
94
95 void
96 debugBelch(const char*s, ...)
97 {
98 va_list ap;
99 va_start(ap,s);
100 (*debugMsgFn)(s,ap);
101 va_end(ap);
102 }
103
104 void
105 vdebugBelch(const char*s, va_list ap)
106 {
107 (*debugMsgFn)(s,ap);
108 }
109
110 /* -----------------------------------------------------------------------------
111 stdio versions of the message functions
112 -------------------------------------------------------------------------- */
113
114 #define BUFSIZE 512
115
116 #if defined (mingw32_HOST_OS)
117 static int
118 isGUIApp(void)
119 {
120 PIMAGE_DOS_HEADER pDOSHeader;
121 PIMAGE_NT_HEADERS pPEHeader;
122
123 pDOSHeader = (PIMAGE_DOS_HEADER) GetModuleHandleA(NULL);
124 if (pDOSHeader->e_magic != IMAGE_DOS_SIGNATURE)
125 return 0;
126
127 pPEHeader = (PIMAGE_NT_HEADERS) ((char *)pDOSHeader + pDOSHeader->e_lfanew);
128 if (pPEHeader->Signature != IMAGE_NT_SIGNATURE)
129 return 0;
130
131 return (pPEHeader->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
132 }
133 #endif
134
135 #define xstr(s) str(s)
136 #define str(s) #s
137
138 void GNU_ATTRIBUTE(__noreturn__)
139 rtsFatalInternalErrorFn(const char *s, va_list ap)
140 {
141 #if defined(mingw32_HOST_OS)
142 /* Ensure we're in text mode so newlines get encoded properly. */
143 int mode = _setmode (_fileno(stderr), _O_TEXT);
144 if (isGUIApp())
145 {
146 char title[BUFSIZE], message[BUFSIZE];
147
148 snprintf(title, BUFSIZE, "%s: internal error", prog_name);
149 vsnprintf(message, BUFSIZE, s, ap);
150
151 MessageBox(NULL /* hWnd */,
152 message,
153 title,
154 MB_OK | MB_ICONERROR | MB_TASKMODAL
155 );
156 }
157 else
158 #endif
159 {
160 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
161 if (prog_argv != NULL && prog_name != NULL) {
162 fprintf(stderr, "%s: internal error: ", prog_name);
163 } else {
164 fprintf(stderr, "internal error: ");
165 }
166 vfprintf(stderr, s, ap);
167 #if USE_LIBDW
168 fprintf(stderr, "\n");
169 fprintf(stderr, "Stack trace:\n");
170 LibdwSession *session = libdwInit();
171 Backtrace *bt = libdwGetBacktrace(session);
172 libdwPrintBacktrace(session, stderr, bt);
173 libdwFree(session);
174 #endif
175 fprintf(stderr, "\n");
176 fprintf(stderr, " (GHC version %s for %s)\n", ProjectVersion, xstr(HostPlatform_TYPE));
177 fprintf(stderr, " Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n");
178 fflush(stderr);
179 }
180 #if defined(mingw32_HOST_OS)
181 _setmode (_fileno(stderr), mode);
182 #endif
183
184 #if defined(TRACING)
185 if (RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG) endEventLogging();
186 #endif
187
188 abort();
189 // stg_exit(EXIT_INTERNAL_ERROR);
190 }
191
192 void
193 rtsErrorMsgFn(const char *s, va_list ap)
194 {
195 #if defined(mingw32_HOST_OS)
196 /* Ensure we're in text mode so newlines get encoded properly. */
197 int mode = _setmode (_fileno(stderr), _O_TEXT);
198 if (isGUIApp())
199 {
200 char buf[BUFSIZE];
201 int r;
202
203 r = vsnprintf(buf, BUFSIZE, s, ap);
204 if (r > 0 && r < BUFSIZE) {
205 MessageBox(NULL /* hWnd */,
206 buf,
207 prog_name,
208 MB_OK | MB_ICONERROR | MB_TASKMODAL
209 );
210 }
211 }
212 else
213 #endif
214 {
215 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
216 if (prog_name != NULL) {
217 fprintf(stderr, "%s: ", prog_name);
218 }
219 vfprintf(stderr, s, ap);
220 fprintf(stderr, "\n");
221 }
222 #if defined(mingw32_HOST_OS)
223 _setmode (_fileno(stderr), mode);
224 #endif
225 }
226
227 void
228 rtsSysErrorMsgFn(const char *s, va_list ap)
229 {
230 char *syserr;
231
232 #if defined(mingw32_HOST_OS)
233 /* Ensure we're in text mode so newlines get encoded properly. */
234 int mode = _setmode (_fileno(stderr), _O_TEXT);
235 FormatMessage(
236 FORMAT_MESSAGE_ALLOCATE_BUFFER |
237 FORMAT_MESSAGE_FROM_SYSTEM |
238 FORMAT_MESSAGE_IGNORE_INSERTS,
239 NULL,
240 GetLastError(),
241 MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
242 (LPTSTR) &syserr,
243 0,
244 NULL );
245
246 if (isGUIApp())
247 {
248 char buf[BUFSIZE];
249 int r;
250
251 r = vsnprintf(buf, BUFSIZE, s, ap);
252 if (r > 0 && r < BUFSIZE) {
253 r = vsnprintf(buf+r, BUFSIZE-r, ": %s", syserr);
254 MessageBox(NULL /* hWnd */,
255 buf,
256 prog_name,
257 MB_OK | MB_ICONERROR | MB_TASKMODAL
258 );
259 }
260 }
261 else
262 #else
263 syserr = strerror(errno);
264 // ToDo: use strerror_r() if available
265 #endif
266 {
267 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
268 if (prog_argv != NULL && prog_name != NULL) {
269 fprintf(stderr, "%s: ", prog_name);
270 }
271 vfprintf(stderr, s, ap);
272 if (syserr) {
273 #if defined(mingw32_HOST_OS)
274 // Win32 error messages have a terminating \n
275 fprintf(stderr, ": %s", syserr);
276 #else
277 fprintf(stderr, ": %s\n", syserr);
278 #endif
279 } else {
280 fprintf(stderr, "\n");
281 }
282 }
283
284 #if defined(mingw32_HOST_OS)
285 if (syserr) LocalFree(syserr);
286 _setmode (_fileno(stderr), mode);
287 #endif
288 }
289
290 void
291 rtsDebugMsgFn(const char *s, va_list ap)
292 {
293 #if defined(mingw32_HOST_OS)
294 /* Ensure we're in text mode so newlines get encoded properly. */
295 int mode = _setmode (_fileno(stderr), _O_TEXT);
296 if (isGUIApp())
297 {
298 char buf[BUFSIZE];
299 int r;
300
301 r = vsnprintf(buf, BUFSIZE, s, ap);
302 if (r > 0 && r < BUFSIZE) {
303 OutputDebugString(buf);
304 }
305 }
306 else
307 #endif
308 {
309 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
310 vfprintf(stderr, s, ap);
311 fflush(stderr);
312 }
313 #if defined(mingw32_HOST_OS)
314 _setmode (_fileno(stderr), mode);
315 #endif
316 }
317
318
319 // Used in stg_badAlignment_entry defined in StgStartup.cmm.
320 void rtsBadAlignmentBarf(void) GNUC3_ATTRIBUTE(__noreturn__);
321
322 void
323 rtsBadAlignmentBarf()
324 {
325 barf("Encountered incorrectly aligned pointer. This can't be good.");
326 }