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