1/* 2 * tclPanic.c -- 3 * 4 * Source code for the "Tcl_Panic" library procedure for Tcl; 5 * individual applications will probably call Tcl_SetPanicProc() 6 * to set an application-specific panic procedure. 7 * 8 * Copyright (c) 1988-1993 The Regents of the University of California. 9 * Copyright (c) 1994 Sun Microsystems, Inc. 10 * Copyright (c) 1998-1999 by Scriptics Corporation. 11 * 12 * See the file "license.terms" for information on usage and redistribution 13 * of this file, and for a DISCLAIMER OF ALL WARRANTIES. 14 * 15 * RCS: @(#) $Id: tclPanic.c,v 1.4.12.2 2006/03/09 23:11:23 dgp Exp $ 16 */ 17 18#include "tclInt.h" 19#include "tclPort.h" 20 21/* 22 * The panicProc variable contains a pointer to an application 23 * specific panic procedure. 24 */ 25 26static Tcl_PanicProc *panicProc = NULL; 27 28/* 29 * The platformPanicProc variable contains a pointer to a platform 30 * specific panic procedure, if any. ( TclpPanic may be NULL via 31 * a macro. ) 32 */ 33 34static Tcl_PanicProc * CONST platformPanicProc = TclpPanic; 35 36 37/* 38 *---------------------------------------------------------------------- 39 * 40 * Tcl_SetPanicProc -- 41 * 42 * Replace the default panic behavior with the specified functiion. 43 * 44 * Results: 45 * None. 46 * 47 * Side effects: 48 * Sets the panicProc variable. 49 * 50 *---------------------------------------------------------------------- 51 */ 52 53void 54Tcl_SetPanicProc(proc) 55 Tcl_PanicProc *proc; 56{ 57 panicProc = proc; 58} 59 60/* 61 *---------------------------------------------------------------------- 62 * 63 * Tcl_PanicVA -- 64 * 65 * Print an error message and kill the process. 66 * 67 * Results: 68 * None. 69 * 70 * Side effects: 71 * The process dies, entering the debugger if possible. 72 * 73 *---------------------------------------------------------------------- 74 */ 75 76void 77Tcl_PanicVA (format, argList) 78 CONST char *format; /* Format string, suitable for passing to 79 * fprintf. */ 80 va_list argList; /* Variable argument list. */ 81{ 82 char *arg1, *arg2, *arg3, *arg4; /* Additional arguments (variable in 83 * number) to pass to fprintf. */ 84 char *arg5, *arg6, *arg7, *arg8; 85 86 arg1 = va_arg(argList, char *); 87 arg2 = va_arg(argList, char *); 88 arg3 = va_arg(argList, char *); 89 arg4 = va_arg(argList, char *); 90 arg5 = va_arg(argList, char *); 91 arg6 = va_arg(argList, char *); 92 arg7 = va_arg(argList, char *); 93 arg8 = va_arg(argList, char *); 94 95 if (panicProc != NULL) { 96 (void) (*panicProc)(format, arg1, arg2, arg3, arg4, 97 arg5, arg6, arg7, arg8); 98 } else if (platformPanicProc != NULL) { 99 (void) (*platformPanicProc)(format, arg1, arg2, arg3, arg4, 100 arg5, arg6, arg7, arg8); 101 } else { 102 (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, 103 arg7, arg8); 104 (void) fprintf(stderr, "\n"); 105 (void) fflush(stderr); 106 abort(); 107 } 108} 109 110/* 111 *---------------------------------------------------------------------- 112 * 113 * Tcl_Panic -- 114 * 115 * Print an error message and kill the process. 116 * 117 * Results: 118 * None. 119 * 120 * Side effects: 121 * The process dies, entering the debugger if possible. 122 * 123 *---------------------------------------------------------------------- 124 */ 125 126 /* VARARGS ARGSUSED */ 127void 128Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1) 129{ 130 va_list argList; 131 CONST char *format; 132 133 format = TCL_VARARGS_START(CONST char *,arg1,argList); 134 Tcl_PanicVA(format, argList); 135 va_end (argList); 136} 137