ghc/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
  14 #ifdef HAVE_WINDOWS_H
  15 #include <windows.h>
  16 #endif
  17
  18 /* -----------------------------------------------------------------------------
  19    General message generation functions
  20
  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    -------------------------------------------------------------------------- */
  26
  27 // Default to the stdio implementation of these hooks.
  28 RtsMsgFunction *fatalInternalErrorFn = rtsFatalInternalErrorFn;
  29 RtsMsgFunction *debugMsgFn           = rtsDebugMsgFn;
  30 RtsMsgFunction *errorMsgFn           = rtsErrorMsgFn;
  31
  32 void
  33 barf(char *s, ...)
  34 {
  35   va_list ap;
  36   va_start(ap,s);
  37   (*fatalInternalErrorFn)(s,ap);
  38   stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
  39   va_end(ap);
  40 }
  41
  42 void
  43 vbarf(char *s, va_list ap)
  44 {
  45   (*fatalInternalErrorFn)(s,ap);
  46   stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
  47 }
  48
  49 void
  50 _assertFail(char *filename, unsigned int linenum)
  51 {
  52     barf("ASSERTION FAILED: file %s, line %u\n", filename, linenum);
  53 }
  54
  55 void
  56 errorBelch(char *s, ...)
  57 {
  58   va_list ap;
  59   va_start(ap,s);
  60   (*errorMsgFn)(s,ap);
  61   va_end(ap);
  62 }
  63
  64 void
  65 verrorBelch(char *s, va_list ap)
  66 {
  67   (*errorMsgFn)(s,ap);
  68 }
  69
  70 void
  71 debugBelch(char *s, ...)
  72 {
  73   va_list ap;
  74   va_start(ap,s);
  75   (*debugMsgFn)(s,ap);
  76   va_end(ap);
  77 }
  78
  79 void
  80 vdebugBelch(char *s, va_list ap)
  81 {
  82   (*debugMsgFn)(s,ap);
  83 }
  84
  85 /* -----------------------------------------------------------------------------
  86    stdio versions of the message functions
  87    -------------------------------------------------------------------------- */
  88
  89 #define BUFSIZE 512
  90
  91 #if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
  92 static int
  93 isGUIApp()
  94 {
  95   PIMAGE_DOS_HEADER pDOSHeader;
  96   PIMAGE_NT_HEADERS pPEHeader;
  97
  98   pDOSHeader = (PIMAGE_DOS_HEADER) GetModuleHandleA(NULL);
  99   if (pDOSHeader->e_magic != IMAGE_DOS_SIGNATURE)
 100     return 0;
 101
 102   pPEHeader = (PIMAGE_NT_HEADERS) ((char *)pDOSHeader + pDOSHeader->e_lfanew);
 103   if (pPEHeader->Signature != IMAGE_NT_SIGNATURE)
 104     return 0;
 105
 106   return (pPEHeader->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
 107 }
 108 #endif
 109
 110 #define xstr(s) str(s)
 111 #define str(s) #s
 112
 113 void
 114 rtsFatalInternalErrorFn(char *s, va_list ap)
 115 {
 116 #if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
 117   if (isGUIApp())
 118   {
 119      char title[BUFSIZE], message[BUFSIZE];
 120
 121      snprintf(title,   BUFSIZE, "%s: internal error", prog_name);
 122      vsnprintf(message, BUFSIZE, s, ap);
 123
 124      MessageBox(NULL /* hWnd */,
 125                 message,
 126                 title,
 127                 MB_OK | MB_ICONERROR | MB_TASKMODAL
 128                );
 129   }
 130   else
 131 #endif
 132   {
 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);
 136      } else {
 137        fprintf(stderr, "internal error: ");
 138      }
 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");
 143      fflush(stderr);
 144   }
 145
 146   abort();
 147   // stg_exit(EXIT_INTERNAL_ERROR);
 148 }
 149
 150 void
 151 rtsErrorMsgFn(char *s, va_list ap)
 152 {
 153 #if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
 154   if (isGUIApp())
 155   {
 156      char buf[BUFSIZE];
 157      int r;
 158
 159          r = vsnprintf(buf, BUFSIZE, s, ap);
 160          if (r > 0 && r < BUFSIZE) {
 161                 MessageBox(NULL /* hWnd */,
 162               buf,
 163               prog_name,
 164               MB_OK | MB_ICONERROR | MB_TASKMODAL
 165               );
 166      }
 167   }
 168   else
 169 #endif
 170   {
 171      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 172      if (prog_argv != NULL && prog_name != NULL) {
 173        fprintf(stderr, "%s: ", prog_name);
 174      }
 175      vfprintf(stderr, s, ap);
 176      fprintf(stderr, "\n");
 177   }
 178 }
 179
 180 void
 181 rtsDebugMsgFn(char *s, va_list ap)
 182 {
 183 #if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
 184   if (isGUIApp())
 185   {
 186      char buf[BUFSIZE];
 187          int r;
 188
 189          r = vsnprintf(buf, BUFSIZE, s, ap);
 190          if (r > 0 && r < BUFSIZE) {
 191        OutputDebugString(buf);
 192      }
 193   }
 194   else
 195 #endif
 196   {
 197      /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 198      vfprintf(stderr, s, ap);
 199      fflush(stderr);
 200   }
 201 }