1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 1998-2004
5 * General utility functions used in the RTS.
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
20 /* -----------------------------------------------------------------------------
21 General message generation functions
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 -------------------------------------------------------------------------- */
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;
36 barf(const char*s, ...)
40 (*fatalInternalErrorFn)(s,ap);
41 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
46 vbarf(const char*s, va_list ap)
48 (*fatalInternalErrorFn)(s,ap);
49 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
53 _assertFail(const char*filename, unsigned int linenum)
55 barf("ASSERTION FAILED: file %s, line %u\n", filename, linenum);
59 errorBelch(const char*s, ...)
68 verrorBelch(const char*s, va_list ap)
74 sysErrorBelch(const char*s, ...)
78 (*sysErrorMsgFn)(s,ap);
83 vsysErrorBelch(const char*s, va_list ap)
85 (*sysErrorMsgFn)(s,ap);
89 debugBelch(const char*s, ...)
98 vdebugBelch(const char*s, va_list ap)
103 /* -----------------------------------------------------------------------------
104 stdio versions of the message functions
105 -------------------------------------------------------------------------- */
109 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
113 PIMAGE_DOS_HEADER pDOSHeader;
114 PIMAGE_NT_HEADERS pPEHeader;
116 pDOSHeader = (PIMAGE_DOS_HEADER) GetModuleHandleA(NULL);
117 if (pDOSHeader->e_magic != IMAGE_DOS_SIGNATURE)
120 pPEHeader = (PIMAGE_NT_HEADERS) ((char *)pDOSHeader + pDOSHeader->e_lfanew);
121 if (pPEHeader->Signature != IMAGE_NT_SIGNATURE)
124 return (pPEHeader->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
128 #define xstr(s) str(s)
132 rtsFatalInternalErrorFn(const char *s, va_list ap)
134 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
137 char title[BUFSIZE], message[BUFSIZE];
139 snprintf(title, BUFSIZE, "%s: internal error", prog_name);
140 vsnprintf(message, BUFSIZE, s, ap);
142 MessageBox(NULL /* hWnd */,
145 MB_OK | MB_ICONERROR | MB_TASKMODAL
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);
155 fprintf(stderr, "internal error: ");
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");
165 // stg_exit(EXIT_INTERNAL_ERROR);
169 rtsErrorMsgFn(const char *s, va_list ap)
171 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
177 r = vsnprintf(buf, BUFSIZE, s, ap);
178 if (r > 0 && r < BUFSIZE) {
179 MessageBox(NULL /* hWnd */,
182 MB_OK | MB_ICONERROR | MB_TASKMODAL
189 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
190 if (prog_argv != NULL && prog_name != NULL) {
191 fprintf(stderr, "%s: ", prog_name);
193 vfprintf(stderr, s, ap);
194 fprintf(stderr, "\n");
199 rtsSysErrorMsgFn(const char *s, va_list ap)
203 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
205 FORMAT_MESSAGE_ALLOCATE_BUFFER |
206 FORMAT_MESSAGE_FROM_SYSTEM |
207 FORMAT_MESSAGE_IGNORE_INSERTS,
210 MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT), // Default language
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 */,
226 MB_OK | MB_ICONERROR | MB_TASKMODAL
232 syserr = strerror(errno);
233 // ToDo: use strerror_r() if available
236 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
237 if (prog_argv != NULL && prog_name != NULL) {
238 fprintf(stderr, "%s: ", prog_name);
240 vfprintf(stderr, s, ap);
242 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
243 // Win32 error messages have a terminating \n
244 fprintf(stderr, ": %s", syserr);
246 fprintf(stderr, ": %s\n", syserr);
249 fprintf(stderr, "\n");
253 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
254 if (syserr) LocalFree(syserr);
259 rtsDebugMsgFn(const char *s, va_list ap)
261 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
267 r = vsnprintf(buf, BUFSIZE, s, ap);
268 if (r > 0 && r < BUFSIZE) {
269 OutputDebugString(buf);
275 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
276 vfprintf(stderr, s, ap);