1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
|
/*
* tclPanic.c --
*
* Source code for the "Tcl_Panic" library procedure for Tcl; individual
* applications will probably call Tcl_SetPanicProc() to set an
* application-specific panic procedure.
*
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
* Copyright (c) 1998-1999 by Scriptics Corporation.
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* RCS: @(#) $Id: tclPanic.c,v 1.18 2010/12/16 08:52:37 nijtmans Exp $
*/
#include "tclInt.h"
#ifdef _WIN32
# ifdef _MSC_VER
# include <intrin.h>
# endif
MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
#endif
/*
* The panicProc variable contains a pointer to an application specific panic
* procedure.
*/
static Tcl_PanicProc *panicProc = NULL;
/*
*----------------------------------------------------------------------
*
* Tcl_SetPanicProc --
*
* Replace the default panic behavior with the specified function.
*
* Results:
* None.
*
* Side effects:
* Sets the panicProc variable.
*
*----------------------------------------------------------------------
*/
void
Tcl_SetPanicProc(
Tcl_PanicProc *proc)
{
#ifdef _WIN32
/* tclWinDebugPanic only installs if there is no panicProc yet. */
if ((proc != tclWinDebugPanic) || (panicProc == NULL))
#endif
panicProc = proc;
}
/*
*----------------------------------------------------------------------
*
* Tcl_PanicVA --
*
* Print an error message and kill the process.
*
* Results:
* None.
*
* Side effects:
* The process dies, entering the debugger if possible.
*
*----------------------------------------------------------------------
*/
void
Tcl_PanicVA(
const char *format, /* Format string, suitable for passing to
* fprintf. */
va_list argList) /* Variable argument list. */
{
char *arg1, *arg2, *arg3; /* Additional arguments (variable in number)
* to pass to fprintf. */
char *arg4, *arg5, *arg6, *arg7, *arg8;
arg1 = va_arg(argList, char *);
arg2 = va_arg(argList, char *);
arg3 = va_arg(argList, char *);
arg4 = va_arg(argList, char *);
arg5 = va_arg(argList, char *);
arg6 = va_arg(argList, char *);
arg7 = va_arg(argList, char *);
arg8 = va_arg(argList, char *);
if (panicProc != NULL) {
panicProc(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
#ifdef _WIN32
} else if (IsDebuggerPresent()) {
tclWinDebugPanic(format, arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
#endif
} else {
fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
arg8);
fprintf(stderr, "\n");
fflush(stderr);
}
/* In case the users panic proc does not abort, we do it here */
#ifdef _WIN32
# ifdef __GNUC__
__builtin_trap();
# elif _MSC_VER
__debugbreak();
# endif
ExitProcess(1);
#else
abort();
#endif
}
/*
*----------------------------------------------------------------------
*
* Tcl_Panic --
*
* Print an error message and kill the process.
*
* Results:
* None.
*
* Side effects:
* The process dies, entering the debugger if possible.
*
*----------------------------------------------------------------------
*/
/* ARGSUSED */
void
Tcl_Panic(
const char *format,
...)
{
va_list argList;
va_start(argList, format);
Tcl_PanicVA(format, argList);
va_end (argList);
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/
|
