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;
37 (*fatalInternalErrorFn)(s,ap);
38 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
43 vbarf(char *s, va_list ap)
45 (*fatalInternalErrorFn)(s,ap);
46 stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
50 _assertFail(char *filename, unsigned int linenum)
52 internalErrorBelch("ASSERTION FAILED: file %s, line %u\n", filename, linenum);
56 internalErrorBelch(char *s, ...)
60 (*fatalInternalErrorFn)(s,ap);
65 errorBelch(char *s, ...)
74 verrorBelch(char *s, va_list ap)
80 debugBelch(char *s, ...)
89 vdebugBelch(char *s, va_list ap)
94 /* -----------------------------------------------------------------------------
95 stdio versions of the message functions
96 -------------------------------------------------------------------------- */
100 #if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
104 PIMAGE_DOS_HEADER pDOSHeader;
105 PIMAGE_NT_HEADERS pPEHeader;
107 pDOSHeader = (PIMAGE_DOS_HEADER) GetModuleHandleA(NULL);
108 if (pDOSHeader->e_magic != IMAGE_DOS_SIGNATURE)
111 pPEHeader = (PIMAGE_NT_HEADERS) ((char *)pDOSHeader + pDOSHeader->e_lfanew);
112 if (pPEHeader->Signature != IMAGE_NT_SIGNATURE)
115 return (pPEHeader->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
120 rtsFatalInternalErrorFn(char *s, va_list ap)
122 #if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
125 char title[BUFSIZE], message[BUFSIZE];
128 r = vsnprintf(title, BUFSIZE, "%s: internal error", prog_name);
129 if (r > 0 && r < BUFSIZE) {
130 strcpy(title, "internal error");
133 r = vsnprintf(message, BUFSIZE, s, ap);
134 if (r > 0 && r < BUFSIZE) {
135 MessageBox(NULL /* hWnd */,
138 MB_OK | MB_ICONERROR | MB_TASKMODAL
145 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
146 if (prog_argv != NULL && prog_name != NULL) {
147 fprintf(stderr, "%s: internal error: ", prog_name);
149 fprintf(stderr, "internal error: ");
151 vfprintf(stderr, s, ap);
152 fprintf(stderr, "\n");
153 fprintf(stderr, " Please report this as a bug to glasgow-haskell-bugs@haskell.org,\n or http://www.sourceforge.net/projects/ghc/\n");
157 stg_exit(EXIT_INTERNAL_ERROR);
161 rtsErrorMsgFn(char *s, va_list ap)
163 #if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
169 r = vsnprintf(buf, BUFSIZE, s, ap);
170 if (r > 0 && r < BUFSIZE) {
171 MessageBox(NULL /* hWnd */,
174 MB_OK | MB_ICONERROR | MB_TASKMODAL
181 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
182 if (prog_argv != NULL && prog_name != NULL) {
183 fprintf(stderr, "%s: ", prog_name);
185 vfprintf(stderr, s, ap);
186 fprintf(stderr, "\n");
191 rtsDebugMsgFn(char *s, va_list ap)
193 #if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
199 r = vsnprintf(buf, BUFSIZE, s, ap);
200 if (r > 0 && r < BUFSIZE) {
201 OutputDebugString(buf);
207 /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
208 vfprintf(stderr, s, ap);