1 /* -----------------------------------------------------------------------------
3 * (c) The GHC Team, 1998-2004
5 * General utility functions used in the RTS.
7 * ---------------------------------------------------------------------------*/
9 #include "PosixSource.h"
18 /* -----------------------------------------------------------------------------
19 General message generation functions
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 -------------------------------------------------------------------------- */
27 // Default to the stdio implementation of these hooks.
28 RtsMsgFunction *fatalInternalErrorFn = rtsFatalInternalErrorFn;
29 RtsMsgFunction *debugMsgFn = rtsDebugMsgFn;
30 RtsMsgFunction *errorMsgFn = rtsErrorMsgFn;
33 barf(const char*s, ...)
37 (*fatalInternalErrorFn)(s,ap);
38 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
43 vbarf(const char*s, va_list ap)
45 (*fatalInternalErrorFn)(s,ap);
46 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
50 _assertFail(const char*filename, unsigned int linenum)
52 barf("ASSERTION FAILED: file %s, line %u\n", filename, linenum);
56 errorBelch(const char*s, ...)
65 verrorBelch(const char*s, va_list ap)
71 debugBelch(const char*s, ...)
80 vdebugBelch(const char*s, va_list ap)
85 /* -----------------------------------------------------------------------------
86 stdio versions of the message functions
87 -------------------------------------------------------------------------- */
91 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
95 PIMAGE_DOS_HEADER pDOSHeader;
96 PIMAGE_NT_HEADERS pPEHeader;
98 pDOSHeader = (PIMAGE_DOS_HEADER) GetModuleHandleA(NULL);
99 if (pDOSHeader->e_magic != IMAGE_DOS_SIGNATURE)
102 pPEHeader = (PIMAGE_NT_HEADERS) ((char *)pDOSHeader + pDOSHeader->e_lfanew);
103 if (pPEHeader->Signature != IMAGE_NT_SIGNATURE)
106 return (pPEHeader->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
110 #define xstr(s) str(s)
114 rtsFatalInternalErrorFn(const char *s, va_list ap)
116 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
119 char title[BUFSIZE], message[BUFSIZE];
121 snprintf(title, BUFSIZE, "%s: internal error", prog_name);
122 vsnprintf(message, BUFSIZE, s, ap);
124 MessageBox(NULL /* hWnd */,
127 MB_OK | MB_ICONERROR | MB_TASKMODAL
133 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
134 if (prog_argv != NULL && prog_name != NULL) {
135 fprintf(stderr, "%s: internal error: ", prog_name);
137 fprintf(stderr, "internal error: ");
139 vfprintf(stderr, s, ap);
140 fprintf(stderr, "\n");
141 fprintf(stderr, " (GHC version %s for %s)\n", ProjectVersion, xstr(HostPlatform_TYPE));
142 fprintf(stderr, " Please report this as a GHC bug: http://www.haskell.org/ghc/reportabug\n");
147 // stg_exit(EXIT_INTERNAL_ERROR);
151 rtsErrorMsgFn(const char *s, va_list ap)
153 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
159 r = vsnprintf(buf, BUFSIZE, s, ap);
160 if (r > 0 && r < BUFSIZE) {
161 MessageBox(NULL /* hWnd */,
164 MB_OK | MB_ICONERROR | MB_TASKMODAL
171 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
172 if (prog_argv != NULL && prog_name != NULL) {
173 fprintf(stderr, "%s: ", prog_name);
175 vfprintf(stderr, s, ap);
176 fprintf(stderr, "\n");
181 rtsDebugMsgFn(const char *s, va_list ap)
183 #if defined(cygwin32_HOST_OS) || defined (mingw32_HOST_OS)
189 r = vsnprintf(buf, BUFSIZE, s, ap);
190 if (r > 0 && r < BUFSIZE) {
191 OutputDebugString(buf);
197 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
198 vfprintf(stderr, s, ap);