/[dtapublic]/projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclpanic.c
ViewVC logotype

Contents of /projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclpanic.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 44 - (show annotations) (download)
Fri Oct 14 02:09:58 2016 UTC (8 years, 2 months ago) by dashley
File MIME type: text/plain
File size: 3469 byte(s)
Rename for reorganization.
1 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclpanic.c,v 1.1.1.1 2001/06/13 04:44:06 dtashley Exp $ */
2
3 /*
4 * tclPanic.c --
5 *
6 * Source code for the "Tcl_Panic" library procedure for Tcl;
7 * individual applications will probably override this with
8 * an application-specific panic procedure.
9 *
10 * Copyright (c) 1988-1993 The Regents of the University of California.
11 * Copyright (c) 1994 Sun Microsystems, Inc.
12 * Copyright (c) 1998-1999 by Scriptics Corporation.
13 *
14 * See the file "license.terms" for information on usage and redistribution
15 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16 *
17 * RCS: @(#) $Id: tclpanic.c,v 1.1.1.1 2001/06/13 04:44:06 dtashley Exp $
18 */
19
20 #include "tclInt.h"
21
22 /*
23 * The panicProc variable contains a pointer to an application
24 * specific panic procedure.
25 */
26
27 void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;
28
29 /*
30 *----------------------------------------------------------------------
31 *
32 * Tcl_SetPanicProc --
33 *
34 * Replace the default panic behavior with the specified functiion.
35 *
36 * Results:
37 * None.
38 *
39 * Side effects:
40 * Sets the panicProc variable.
41 *
42 *----------------------------------------------------------------------
43 */
44
45 void
46 Tcl_SetPanicProc(proc)
47 void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format));
48 {
49 panicProc = proc;
50 }
51
52 /*
53 *----------------------------------------------------------------------
54 *
55 * Tcl_PanicVA --
56 *
57 * Print an error message and kill the process.
58 *
59 * Results:
60 * None.
61 *
62 * Side effects:
63 * The process dies, entering the debugger if possible.
64 *
65 *----------------------------------------------------------------------
66 */
67
68 void
69 Tcl_PanicVA (format, argList)
70 char *format; /* Format string, suitable for passing to
71 * fprintf. */
72 va_list argList; /* Variable argument list. */
73 {
74 char *arg1, *arg2, *arg3, *arg4; /* Additional arguments (variable in
75 * number) to pass to fprintf. */
76 char *arg5, *arg6, *arg7, *arg8;
77
78 arg1 = va_arg(argList, char *);
79 arg2 = va_arg(argList, char *);
80 arg3 = va_arg(argList, char *);
81 arg4 = va_arg(argList, char *);
82 arg5 = va_arg(argList, char *);
83 arg6 = va_arg(argList, char *);
84 arg7 = va_arg(argList, char *);
85 arg8 = va_arg(argList, char *);
86
87 if (panicProc != NULL) {
88 (void) (*panicProc)(format, arg1, arg2, arg3, arg4,
89 arg5, arg6, arg7, arg8);
90 } else {
91 (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
92 arg7, arg8);
93 (void) fprintf(stderr, "\n");
94 (void) fflush(stderr);
95 abort();
96 }
97 }
98
99 /*
100 *----------------------------------------------------------------------
101 *
102 * panic --
103 *
104 * Print an error message and kill the process.
105 *
106 * Results:
107 * None.
108 *
109 * Side effects:
110 * The process dies, entering the debugger if possible.
111 *
112 *----------------------------------------------------------------------
113 */
114
115 /* VARARGS ARGSUSED */
116 void
117 panic TCL_VARARGS_DEF(char *,arg1)
118 {
119 va_list argList;
120 char *format;
121
122 format = TCL_VARARGS_START(char *,arg1,argList);
123 Tcl_PanicVA(format, argList);
124 va_end (argList);
125 }
126
127
128 /* $History: tclpanic.c $
129 *
130 * ***************** Version 1 *****************
131 * User: Dtashley Date: 1/02/01 Time: 1:37a
132 * Created in $/IjuScripter, IjuConsole/Source/Tcl Base
133 * Initial check-in.
134 */
135
136 /* End of TCLPANIC.C */

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25