summaryrefslogtreecommitdiffstats
path: root/generic/tclPanic.c
blob: 394661f2d58946ab481da43c5cfe25dbf8f4e50c (plain)
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
156
157
158
159
160
161
162
163
164
165
166
167
168
169
/*
 * 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 © 1988-1993 The Regents of the University of California.
 * Copyright © 1994 Sun Microsystems, Inc.
 * Copyright © 1998-1999 Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if defined(_WIN32) || defined(__CYGWIN__)
    MODULE_SCOPE TCL_NORETURN void tclWinDebugPanic(const char *format, ...);
#endif

/*
 * The panicProc variable contains a pointer to an application specific panic
 * procedure.
 */

#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetPanicProc --
 *
 *	Replace the default panic behavior with the specified function.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the panicProc variable.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{
#if defined(_WIN32)
    /* tclWinDebugPanic only installs if there is no panicProc yet. */
    if (((Tcl_PanicProc *)proc != tclWinDebugPanic) || (panicProc == NULL))
#elif defined(__CYGWIN__)
    if (proc == NULL)
	panicProc = tclWinDebugPanic;
    else
#endif
    panicProc = proc;
    Tcl_InitSubsystems();
}

/*
 *----------------------------------------------------------------------
 *
 * 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);
#if defined(_WIN32) || defined(__CYGWIN__)
#   if defined(__GNUC__)
	__builtin_trap();
#   elif defined(_WIN64)
	__debugbreak();
#   elif defined(_MSC_VER) && defined (_M_IX86)
	_asm {int 3}
#   else
	DebugBreak();
#   endif
#endif
#if defined(_WIN32)
	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.
 *
 *----------------------------------------------------------------------
 */

/*
 * The following comment is here so that Coverity's static analizer knows that
 * a Tcl_Panic() call can never return and avoids lots of false positives.
 */

/* coverity[+kill] */
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:
 */