Reorganisation of the source tree
[ghc-hetmet.git] / ghc / rts / RtsMessages.c
diff --git a/ghc/rts/RtsMessages.c b/ghc/rts/RtsMessages.c
deleted file mode 100644 (file)
index 1242d88..0000000
+++ /dev/null
@@ -1,201 +0,0 @@
-/* -----------------------------------------------------------------------------
- *
- * (c) The GHC Team, 1998-2004
- *
- * General utility functions used in the RTS.
- *
- * ---------------------------------------------------------------------------*/
-
-#include "PosixSource.h"
-#include "Rts.h"
-
-#include <stdio.h>
-
-#ifdef HAVE_WINDOWS_H
-#include <windows.h>
-#endif
-
-/* -----------------------------------------------------------------------------
-   General message generation functions
-
-   All messages should go through here.  We can't guarantee that
-   stdout/stderr will be available - e.g. in a Windows program there
-   is no console for generating messages, so they have to either go to
-   to the debug console, or pop up message boxes.
-   -------------------------------------------------------------------------- */
-
-// Default to the stdio implementation of these hooks.
-RtsMsgFunction *fatalInternalErrorFn = rtsFatalInternalErrorFn;
-RtsMsgFunction *debugMsgFn           = rtsDebugMsgFn;
-RtsMsgFunction *errorMsgFn           = rtsErrorMsgFn;
-
-void
-barf(char *s, ...)
-{
-  va_list ap;
-  va_start(ap,s);
-  (*fatalInternalErrorFn)(s,ap);
-  stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
-  va_end(ap);
-}
-
-void
-vbarf(char *s, va_list ap)
-{
-  (*fatalInternalErrorFn)(s,ap);
-  stg_exit(EXIT_INTERNAL_ERROR); // just in case fatalInternalErrorFn() returns
-}
-
-void 
-_assertFail(char *filename, unsigned int linenum)
-{
-    barf("ASSERTION FAILED: file %s, line %u\n", filename, linenum);
-}
-
-void
-errorBelch(char *s, ...)
-{
-  va_list ap;
-  va_start(ap,s);
-  (*errorMsgFn)(s,ap);
-  va_end(ap);
-}
-
-void
-verrorBelch(char *s, va_list ap)
-{
-  (*errorMsgFn)(s,ap);
-}
-
-void
-debugBelch(char *s, ...)
-{
-  va_list ap;
-  va_start(ap,s);
-  (*debugMsgFn)(s,ap);
-  va_end(ap);
-}
-
-void
-vdebugBelch(char *s, va_list ap)
-{
-  (*debugMsgFn)(s,ap);
-}
-
-/* -----------------------------------------------------------------------------
-   stdio versions of the message functions
-   -------------------------------------------------------------------------- */
-
-#define BUFSIZE 512
-
-#if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
-static int
-isGUIApp()
-{
-  PIMAGE_DOS_HEADER pDOSHeader;
-  PIMAGE_NT_HEADERS pPEHeader;
-
-  pDOSHeader = (PIMAGE_DOS_HEADER) GetModuleHandleA(NULL);
-  if (pDOSHeader->e_magic != IMAGE_DOS_SIGNATURE)
-    return 0;
-
-  pPEHeader = (PIMAGE_NT_HEADERS) ((char *)pDOSHeader + pDOSHeader->e_lfanew);
-  if (pPEHeader->Signature != IMAGE_NT_SIGNATURE)
-    return 0;
-
-  return (pPEHeader->OptionalHeader.Subsystem == IMAGE_SUBSYSTEM_WINDOWS_GUI);
-}
-#endif
-
-#define xstr(s) str(s)
-#define str(s) #s
-
-void
-rtsFatalInternalErrorFn(char *s, va_list ap)
-{
-#if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
-  if (isGUIApp())
-  {
-     char title[BUFSIZE], message[BUFSIZE];
-
-     snprintf(title,   BUFSIZE, "%s: internal error", prog_name);
-     vsnprintf(message, BUFSIZE, s, ap);
-
-     MessageBox(NULL /* hWnd */,
-               message,
-               title,
-               MB_OK | MB_ICONERROR | MB_TASKMODAL
-              );
-  }
-  else
-#endif
-  {
-     /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-     if (prog_argv != NULL && prog_name != NULL) {
-       fprintf(stderr, "%s: internal error: ", prog_name);
-     } else {
-       fprintf(stderr, "internal error: ");
-     }
-     vfprintf(stderr, s, ap);
-     fprintf(stderr, "\n");
-     fprintf(stderr, "    (GHC version %s for %s)\n", ProjectVersion, xstr(HostPlatform_TYPE));
-     fprintf(stderr, "    Please report this as a GHC bug:  http://www.haskell.org/ghc/reportabug\n");
-     fflush(stderr);
-  }
-
-  abort();
-  // stg_exit(EXIT_INTERNAL_ERROR);
-}
-
-void
-rtsErrorMsgFn(char *s, va_list ap)
-{
-#if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
-  if (isGUIApp())
-  {
-     char buf[BUFSIZE];
-     int r;
-
-        r = vsnprintf(buf, BUFSIZE, s, ap);
-        if (r > 0 && r < BUFSIZE) {
-               MessageBox(NULL /* hWnd */,
-              buf,
-              prog_name,
-              MB_OK | MB_ICONERROR | MB_TASKMODAL
-              );
-     }
-  }
-  else
-#endif
-  {
-     /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-     if (prog_argv != NULL && prog_name != NULL) {
-       fprintf(stderr, "%s: ", prog_name);
-     }
-     vfprintf(stderr, s, ap);
-     fprintf(stderr, "\n");
-  }
-}
-
-void
-rtsDebugMsgFn(char *s, va_list ap)
-{
-#if defined(cygwin32_TARGET_OS) || defined (mingw32_TARGET_OS)
-  if (isGUIApp())
-  {
-     char buf[BUFSIZE];
-        int r;
-
-        r = vsnprintf(buf, BUFSIZE, s, ap);
-        if (r > 0 && r < BUFSIZE) {
-       OutputDebugString(buf);
-     }
-  }
-  else
-#endif
-  {
-     /* don't fflush(stdout); WORKAROUND bug in Linux glibc */
-     vfprintf(stderr, s, ap);
-     fflush(stderr);
-  }
-}