/home/ntakagi/work/tcl8.5.1/generic/tclPanic.c Source File

00001 /*
00002  * tclPanic.c --
00003  *
00004  *      Source code for the "Tcl_Panic" library procedure for Tcl; individual
00005  *      applications will probably call Tcl_SetPanicProc() to set an
00006  *      application-specific panic procedure.
00007  *
00008  * Copyright (c) 1988-1993 The Regents of the University of California.
00009  * Copyright (c) 1994 Sun Microsystems, Inc.
00010  * Copyright (c) 1998-1999 by Scriptics Corporation.
00011  *
00012  * See the file "license.terms" for information on usage and redistribution of
00013  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
00014  *
00015  * RCS: @(#) $Id: tclPanic.c,v 1.10 2006/03/09 23:13:25 dgp Exp $
00016  */
00017 
00018 #include "tclInt.h"
00019 
00020 /*
00021  * The panicProc variable contains a pointer to an application specific panic
00022  * procedure.
00023  */
00024 
00025 static Tcl_PanicProc *panicProc = NULL;
00026 
00027 /*
00028  * The platformPanicProc variable contains a pointer to a platform specific
00029  * panic procedure, if any. (TclpPanic may be NULL via a macro.)
00030  */
00031 
00032 static Tcl_PanicProc *CONST platformPanicProc = TclpPanic;
00033 
00034 /*
00035  *----------------------------------------------------------------------
00036  *
00037  * Tcl_SetPanicProc --
00038  *
00039  *      Replace the default panic behavior with the specified function.
00040  *
00041  * Results:
00042  *      None.
00043  *
00044  * Side effects:
00045  *      Sets the panicProc variable.
00046  *
00047  *----------------------------------------------------------------------
00048  */
00049 
00050 void
00051 Tcl_SetPanicProc(
00052     Tcl_PanicProc *proc)
00053 {
00054     panicProc = proc;
00055 }
00056 
00057 /*
00058  *----------------------------------------------------------------------
00059  *
00060  * Tcl_PanicVA --
00061  *
00062  *      Print an error message and kill the process.
00063  *
00064  * Results:
00065  *      None.
00066  *
00067  * Side effects:
00068  *      The process dies, entering the debugger if possible.
00069  *
00070  *----------------------------------------------------------------------
00071  */
00072 
00073 void
00074 Tcl_PanicVA(
00075     CONST char *format,         /* Format string, suitable for passing to
00076                                  * fprintf. */
00077     va_list argList)            /* Variable argument list. */
00078 {
00079     char *arg1, *arg2, *arg3, *arg4;    /* Additional arguments (variable in
00080                                          * number) to pass to fprintf. */
00081     char *arg5, *arg6, *arg7, *arg8;
00082 
00083     arg1 = va_arg(argList, char *);
00084     arg2 = va_arg(argList, char *);
00085     arg3 = va_arg(argList, char *);
00086     arg4 = va_arg(argList, char *);
00087     arg5 = va_arg(argList, char *);
00088     arg6 = va_arg(argList, char *);
00089     arg7 = va_arg(argList, char *);
00090     arg8 = va_arg(argList, char *);
00091 
00092     if (panicProc != NULL) {
00093         (void) (*panicProc)(format, arg1, arg2, arg3, arg4,
00094                 arg5, arg6, arg7, arg8);
00095     } else if (platformPanicProc != NULL) {
00096         (void) (*platformPanicProc)(format, arg1, arg2, arg3, arg4,
00097                 arg5, arg6, arg7, arg8);
00098     } else {
00099         (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
00100                 arg7, arg8);
00101         (void) fprintf(stderr, "\n");
00102         (void) fflush(stderr);
00103         abort();
00104     }
00105 }
00106 
00107 /*
00108  *----------------------------------------------------------------------
00109  *
00110  * Tcl_Panic --
00111  *
00112  *      Print an error message and kill the process.
00113  *
00114  * Results:
00115  *      None.
00116  *
00117  * Side effects:
00118  *      The process dies, entering the debugger if possible.
00119  *
00120  *----------------------------------------------------------------------
00121  */
00122 
00123         /* ARGSUSED */
00124 void
00125 Tcl_Panic(
00126     CONST char *format,
00127     ...)
00128 {
00129     va_list argList;
00130 
00131     va_start(argList, format);
00132     Tcl_PanicVA(format, argList);
00133     va_end (argList);
00134 }
00135 
00136 /*
00137  * Local Variables:
00138  * mode: c
00139  * c-basic-offset: 4
00140  * fill-column: 78
00141  * End:
00142  */