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 /* -----------------------------------------------------------------------------
  15    General message generation functions
  16
  17    All messages should go through here.  We can't guarantee that
  18    stdout/stderr will be available - e.g. in a Windows program there
  19    is no console for generating messages, so they have to either go to
  20    to the debug console, or pop up message boxes.
  21    -------------------------------------------------------------------------- */
  22
  23 // Default to the stdio implementation of these hooks.
  24 RtsMsgFunction *fatalInternalErrorFn = stdioFatalInternalErrorFn;
  25 RtsMsgFunction *debugMsgFn           = stdioDebugMsgFn;
  26 RtsMsgFunction *errorMsgFn           = stdioErrorMsgFn;
  27
  28 void
  29 barf(char *s, ...)
  30 {
  31   va_list ap;
  32   va_start(ap,s);
  33   (*fatalInternalErrorFn)(s,ap);
  34   stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
  35   va_end(ap);
  36 }
  37
  38 void
  39 vbarf(char *s, va_list ap)
  40 {
  41   (*fatalInternalErrorFn)(s,ap);
  42   stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
  43 }
  44
  45 void
  46 errorBelch(char *s, ...)
  47 {
  48   va_list ap;
  49   va_start(ap,s);
  50   (*errorMsgFn)(s,ap);
  51   va_end(ap);
  52 }
  53
  54 void
  55 verrorBelch(char *s, va_list ap)
  56 {
  57   (*errorMsgFn)(s,ap);
  58 }
  59
  60 void
  61 debugBelch(char *s, ...)
  62 {
  63   va_list ap;
  64   va_start(ap,s);
  65   (*debugMsgFn)(s,ap);
  66   va_end(ap);
  67 }
  68
  69 void
  70 vdebugBelch(char *s, va_list ap)
  71 {
  72   (*debugMsgFn)(s,ap);
  73 }
  74
  75 /* -----------------------------------------------------------------------------
  76    stdio versions of the message functions
  77    -------------------------------------------------------------------------- */
  78
  79 void
  80 stdioFatalInternalErrorFn(char *s, va_list ap)
  81 {
  82   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  83   if (prog_argv != NULL && prog_name != NULL) {
  84     fprintf(stderr, "%s: internal error: ", prog_name);
  85   } else {
  86     fprintf(stderr, "internal error: ");
  87   }
  88   vfprintf(stderr, s, ap);
  89   fprintf(stderr, "\n");
  90   fprintf(stderr, "    Please report this as a bug to glasgow-haskell-bugs@haskell.org,\n    or http://www.sourceforge.net/projects/ghc/\n");
  91   fflush(stderr);
  92   stg_exit(EXIT_INTERNAL_ERROR);
  93 }
  94
  95 void
  96 stdioErrorMsgFn(char *s, va_list ap)
  97 {
  98   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
  99   if (prog_argv != NULL && prog_name != NULL) {
 100     fprintf(stderr, "%s: ", prog_name);
 101   }
 102   vfprintf(stderr, s, ap);
 103   fprintf(stderr, "\n");
 104 }
 105
 106 void
 107 stdioDebugMsgFn(char *s, va_list ap)
 108 {
 109   /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
 110   vfprintf(stderr, s, ap);
 111   fflush(stderr);
 112 }
 113