Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: downloads/tcl8.5.2/generic/tclPanic.c @ 63

Last change on this file since 63 was 25, checked in by landauf, 16 years ago

added tcl to libs

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