1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 1998-2004
5 * General utility functions used in the RTS.
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
12 #include "eventlog/EventLog.h"
22 /* -----------------------------------------------------------------------------
23 General message generation functions
25 All messages should go through here. We can't guarantee that
26 stdout/stderr will be available - e.g. in a Windows program there
27 is no console for generating messages, so they have to either go to
28 to the debug console, or pop up message boxes.
29 -------------------------------------------------------------------------- */
31 // Default to the stdio implementation of these hooks.
32 RtsMsgFunction *fatalInternalErrorFn = rtsFatalInternalErrorFn;
33 RtsMsgFunction *debugMsgFn = rtsDebugMsgFn;
34 RtsMsgFunction *errorMsgFn = rtsErrorMsgFn;
35 RtsMsgFunction *sysErrorMsgFn = rtsSysErrorMsgFn;
38 barf(const char*s, ...)
42 (*fatalInternalErrorFn)(s,ap);
43 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
48 vbarf(const char*s, va_list ap)
50 (*fatalInternalErrorFn)(s,ap);
51 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
55 _assertFail(const char*filename, unsigned int linenum)
57 barf("ASSERTION FAILED: file %s, line %u\n", filename, linenum);
61 errorBelch(const char*s, ...)
70 verrorBelch(const char*s, va_list ap)
76 sysErrorBelch(const char*s, ...)
80 (*sysErrorMsgFn)(s,ap);
85 vsysErrorBelch(const char*s, va_list ap)
87 (*sysErrorMsgFn)(s,ap);
91 debugBelch(const char*s, ...)
100 vdebugBelch(const char*s, va_list ap)
105 /* -----------------------------------------------------------------------------
106 stdio versions of the message functions
107 -------------------------------------------------------------------------- */
111 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
115 PIMAGE_DOS_HEADER pDOSHeader;
116 PIMAGE_NT_HEADERS pPEHeader;
118 pDOSHeader = (PIMAGE_DOS_HEADER) GetModuleHandleA(NULL);
119 if (pDOSHeader->e_magic != IMAGE_DOS_SIGNATURE)
122 pPEHeader = (PIMAGE_NT_HEADERS) ((char *)pDOSHeader + pDOSHeader->e_lfanew);
123 if (pPEHeader->Signature != IMAGE_NT_SIGNATURE)
126 return (pPEHeader->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
130 #define xstr(s) str(s)
133 void GNU_ATTRIBUTE(__noreturn__)
134 rtsFatalInternalErrorFn(const char *s, va_list ap)
136 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
139 char title[BUFSIZE], message[BUFSIZE];
141 snprintf(title, BUFSIZE, "%s: internal error", prog_name);
142 vsnprintf(message, BUFSIZE, s, ap);
144 MessageBox(NULL /* hWnd */,
147 MB_OK | MB_ICONERROR | MB_TASKMODAL
153 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
154 if (prog_argv != NULL && prog_name != NULL) {
155 fprintf(stderr, "%s: internal error: ", prog_name);
157 fprintf(stderr, "internal error: ");
159 vfprintf(stderr, s, ap);
160 fprintf(stderr, "\n");
161 fprintf(stderr, " (GHC version %s for %s)\n", ProjectVersion, xstr(HostPlatform_TYPE));
162 fprintf(stderr, " Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n");
167 if (RtsFlags.TraceFlags.tracing == TRACE_EVENTLOG) endEventLogging();
171 // stg_exit(EXIT_INTERNAL_ERROR);
175 rtsErrorMsgFn(const char *s, va_list ap)
177 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
183 r = vsnprintf(buf, BUFSIZE, s, ap);
184 if (r > 0 && r < BUFSIZE) {
185 MessageBox(NULL /* hWnd */,
188 MB_OK | MB_ICONERROR | MB_TASKMODAL
195 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
196 if (prog_name != NULL) {
197 fprintf(stderr, "%s: ", prog_name);
199 vfprintf(stderr, s, ap);
200 fprintf(stderr, "\n");
205 rtsSysErrorMsgFn(const char *s, va_list ap)
209 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
211 FORMAT_MESSAGE_ALLOCATE_BUFFER |
212 FORMAT_MESSAGE_FROM_SYSTEM |
213 FORMAT_MESSAGE_IGNORE_INSERTS,
216 MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
226 r = vsnprintf(buf, BUFSIZE, s, ap);
227 if (r > 0 && r < BUFSIZE) {
228 r = vsnprintf(buf+r, BUFSIZE-r, ": %s", syserr);
229 MessageBox(NULL /* hWnd */,
232 MB_OK | MB_ICONERROR | MB_TASKMODAL
238 syserr = strerror(errno);
239 // ToDo: use strerror_r() if available
242 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
243 if (prog_argv != NULL && prog_name != NULL) {
244 fprintf(stderr, "%s: ", prog_name);
246 vfprintf(stderr, s, ap);
248 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
249 // Win32 error messages have a terminating \n
250 fprintf(stderr, ": %s", syserr);
252 fprintf(stderr, ": %s\n", syserr);
255 fprintf(stderr, "\n");
259 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
260 if (syserr) LocalFree(syserr);
265 rtsDebugMsgFn(const char *s, va_list ap)
267 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
273 r = vsnprintf(buf, BUFSIZE, s, ap);
274 if (r > 0 && r < BUFSIZE) {
275 OutputDebugString(buf);
281 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
282 vfprintf(stderr, s, ap);