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

Properties

Name Value
svn:eol-style native
svn:keywords Header

dashley@gmail.com
ViewVC Help
Powered by ViewVC 1.1.25