From 1d10874717ff05d2babc9cbf079d5895fcc0a922 Mon Sep 17 00:00:00 2001 From: simonmar Date: Mon, 6 Sep 2004 11:12:02 +0000 Subject: [PATCH] [project @ 2004-09-06 11:10:32 by simonmar] Further to the RTS messaging tidyup: export the new message API and hooks via RtsMessages.h, so that a client program can easily redirect messages. --- ghc/includes/Rts.h | 3 +- ghc/includes/RtsMessages.h | 73 ++++++++++++++++++++++++++++ ghc/rts/RtsMessages.c | 113 ++++++++++++++++++++++++++++++++++++++++++++ ghc/rts/RtsUtils.c | 87 ---------------------------------- ghc/rts/RtsUtils.h | 60 ++++------------------- 5 files changed, 197 insertions(+), 139 deletions(-) create mode 100644 ghc/includes/RtsMessages.h create mode 100644 ghc/rts/RtsMessages.c diff --git a/ghc/includes/Rts.h b/ghc/includes/Rts.h index 1b07a84..c7531ff 100644 --- a/ghc/includes/Rts.h +++ b/ghc/includes/Rts.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: Rts.h,v 1.26 2004/08/22 16:40:38 panne Exp $ + * $Id: Rts.h,v 1.27 2004/09/06 11:10:34 simonmar Exp $ * * (c) The GHC Team, 1998-1999 * @@ -154,6 +154,7 @@ void _stgAssert (char *, unsigned int); /* Runtime-system hooks */ #include "Hooks.h" +#include "RtsMessages.h" #include "ieee-flpt.h" diff --git a/ghc/includes/RtsMessages.h b/ghc/includes/RtsMessages.h new file mode 100644 index 0000000..8206bb9 --- /dev/null +++ b/ghc/includes/RtsMessages.h @@ -0,0 +1,73 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * Message API for use inside the RTS. All messages generated by the + * RTS should go through one of the functions declared here, and we + * also provide hooks so that messages from the RTS can be redirected + * as appropriate. + * + * ---------------------------------------------------------------------------*/ + +#ifndef RTSMESSAGES_H +#define RTSMESSAGES_H + +#include + +/* ----------------------------------------------------------------------------- + * Message generation + * -------------------------------------------------------------------------- */ + +/* + * A fatal internal error: this is for errors that probably indicate + * bugs in the RTS or compiler. We normally output bug reporting + * instructions along with the error message. + * + * barf() invokes (*fatalInternalErrorFn)(). This function is not + * expected to return. + */ +extern void barf(char *s, ...) + GNUC3_ATTRIBUTE(__noreturn__); + +extern void vbarf(char *s, va_list ap) + GNUC3_ATTRIBUTE(__noreturn__); + +/* + * An error condition which is caused by and/or can be corrected by + * the user. + * + * errorBelch() invokes (*errorMsgFn)(). + */ +extern void errorBelch(char *s, ...) + GNUC3_ATTRIBUTE(format (printf, 1, 2)); + +extern void verrorBelch(char *s, va_list ap); + +/* + * A debugging message. Debugging messages are generated either as a + * virtue of having DEBUG turned on, or by being explicitly selected + * via RTS options (eg. +RTS -Ds). + * + * debugBelch() invokes (*debugMsgFn)(). + */ +extern void debugBelch(char *s, ...) + GNUC3_ATTRIBUTE(format (printf, 1, 2)); + +extern void vdebugBelch(char *s, va_list ap); + + +/* Hooks for redirecting message generation: */ + +typedef void RtsMsgFunction(char *, va_list); + +extern RtsMsgFunction *fatalInternalErrorFn; +extern RtsMsgFunction *debugMsgFn; +extern RtsMsgFunction *errorMsgFn; + +/* Default stdio implementation of the message hooks: */ + +extern RtsMsgFunction stdioFatalInternalErrorFn; +extern RtsMsgFunction stdioDebugMsgFn; +extern RtsMsgFunction stdioErrorMsgFn; + +#endif // RTSMESSAGES_H diff --git a/ghc/rts/RtsMessages.c b/ghc/rts/RtsMessages.c new file mode 100644 index 0000000..08df965 --- /dev/null +++ b/ghc/rts/RtsMessages.c @@ -0,0 +1,113 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The GHC Team, 1998-2004 + * + * General utility functions used in the RTS. + * + * ---------------------------------------------------------------------------*/ + +#include "PosixSource.h" +#include "Rts.h" + +#include + +/* ----------------------------------------------------------------------------- + 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 = stdioFatalInternalErrorFn; +RtsMsgFunction *debugMsgFn = stdioDebugMsgFn; +RtsMsgFunction *errorMsgFn = stdioErrorMsgFn; + +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 +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 + -------------------------------------------------------------------------- */ + +void +stdioFatalInternalErrorFn(char *s, va_list ap) +{ + /* 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, " Please report this as a bug to glasgow-haskell-bugs@haskell.org,\n or http://www.sourceforge.net/projects/ghc/\n"); + fflush(stderr); + stg_exit(EXIT_INTERNAL_ERROR); +} + +void +stdioErrorMsgFn(char *s, va_list ap) +{ + /* 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 +stdioDebugMsgFn(char *s, va_list ap) +{ + /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ + vfprintf(stderr, s, ap); + fflush(stderr); +} + diff --git a/ghc/rts/RtsUtils.c b/ghc/rts/RtsUtils.c index 99bea75..89a8af1 100644 --- a/ghc/rts/RtsUtils.c +++ b/ghc/rts/RtsUtils.c @@ -10,10 +10,8 @@ /* #include "PosixSource.h" */ #include "Rts.h" -#include "RtsTypes.h" #include "RtsAPI.h" #include "RtsFlags.h" -#include "Hooks.h" #include "RtsUtils.h" #include "Ticky.h" @@ -35,91 +33,6 @@ #include /* ----------------------------------------------------------------------------- - 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. - -------------------------------------------------------------------------- */ - -RtsMsgFunction *fatalInternalMsgFn = stdioFatalInternalMsgFn; -RtsMsgFunction *debugMsgFn = stdioDebugMsgFn; -RtsMsgFunction *errorMsgFn = stdioErrorMsgFn; - -void -barf(char *s, ...) -{ - va_list ap; - va_start(ap,s); - (*fatalInternalMsgFn)(s,ap); - stg_exit(EXIT_INTERNAL_ERROR); - va_end(ap); -} - -void -errorBelch(char *s, ...) -{ - va_list ap; - va_start(ap,s); - (*errorMsgFn)(s,ap); - va_end(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 - -------------------------------------------------------------------------- */ - -void -stdioFatalInternalMsgFn(char *s, va_list ap) -{ - /* 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, " Please report this as a bug to glasgow-haskell-bugs@haskell.org,\n or http://www.sourceforge.net/projects/ghc/\n"); - fflush(stderr); -} - -void -stdioErrorMsgFn(char *s, va_list ap) -{ - /* 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 -stdioDebugMsgFn(char *s, va_list ap) -{ - /* don't fflush(stdout); WORKAROUND bug in Linux glibc */ - vfprintf(stderr, s, ap); - fflush(stderr); -} - -/* ----------------------------------------------------------------------------- Result-checking malloc wrappers. -------------------------------------------------------------------------- */ diff --git a/ghc/rts/RtsUtils.h b/ghc/rts/RtsUtils.h index 6f7111f..97769b9 100644 --- a/ghc/rts/RtsUtils.h +++ b/ghc/rts/RtsUtils.h @@ -9,62 +9,20 @@ #ifndef RTSUTILS_H #define RTSUTILS_H -#include - /* ----------------------------------------------------------------------------- - * Message generation + * (Checked) dynamic allocation * -------------------------------------------------------------------------- */ -/* - * A fatal internal error: this is for errors that probably indicate - * bugs in the RTS or compiler. We normally output bug reporting - * instructions along with the error message. - */ -extern void barf(char *s, ...) - GNUC3_ATTRIBUTE(__noreturn__); - -/* - * An error condition which is caused by and/or can be corrected by - * the user. - */ -extern void errorBelch(char *s, ...) - GNUC3_ATTRIBUTE(format (printf, 1, 2)); - -/* - * A debugging message. Debugging messages are generated either as a - * virtue of having DEBUG turned on, or by being explicitly selected - * via RTS options (eg. +RTS -Ds). - */ -extern void debugBelch(char *s, ...) - GNUC3_ATTRIBUTE(format (printf, 1, 2)); - -/* Version of debugBelch() that takes parameters as a va_list */ -extern void vdebugBelch(char *s, va_list ap); - -/* Hooks for redirecting message generation: */ - -typedef void RtsMsgFunction(char *, va_list); - -extern RtsMsgFunction *fatalInternalMsgFn; -extern RtsMsgFunction *debugMsgFn; -extern RtsMsgFunction *errorMsgFn; +extern void *stgMallocBytes(int n, char *msg) + GNUC3_ATTRIBUTE(__malloc__); -/* Default stdio implementation of the message hooks: */ +extern void *stgReallocBytes(void *p, int n, char *msg); -extern RtsMsgFunction stdioFatalInternalMsgFn; -extern RtsMsgFunction stdioDebugMsgFn; -extern RtsMsgFunction stdioErrorMsgFn; +extern void *stgCallocBytes(int n, int m, char *msg) + GNUC3_ATTRIBUTE(__malloc__); -/* ----------------------------------------------------------------------------- - * (Checked) dynamic allocation - * -------------------------------------------------------------------------- */ - -extern void *stgMallocBytes(int n, char *msg) GNUC3_ATTRIBUTE(__malloc__); -extern void *stgReallocBytes(void *p, int n, char *msg); -extern void *stgCallocBytes(int n, int m, char *msg) GNUC3_ATTRIBUTE(__malloc__); extern void stgFree(void* p); - /* ----------------------------------------------------------------------------- * Misc other utilities * -------------------------------------------------------------------------- */ @@ -78,11 +36,11 @@ extern void resetNonBlockingFd(int fd); extern nat stg_strlen(char *str); -char *time_str(void); -char *ullong_format_string(ullong, char *, rtsBool); +extern char *time_str(void); +extern char *ullong_format_string(ullong, char *, rtsBool); #ifdef PAR -ullong msTime(void); +extern ullong msTime(void); #endif #ifdef DEBUG -- 1.7.10.4