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

Diff of /projs/dtats/trunk/shared_source/c_tcl_base_7_5_w_mods/tclpanic.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

projs/trunk/shared_source/tcl_base/tclpanic.c revision 42 by dashley, Fri Oct 14 01:50:00 2016 UTC projs/trunk/shared_source/c_tcl_base_7_5_w_mods/tclpanic.c revision 71 by dashley, Sat Nov 5 11:07:06 2016 UTC
# Line 1  Line 1 
 /* $Header: /cvsroot/esrg/sfesrg/esrgpcpj/shared/tcl_base/tclpanic.c,v 1.1.1.1 2001/06/13 04:44:06 dtashley Exp $ */  
   
 /*  
  * tclPanic.c --  
  *  
  *      Source code for the "Tcl_Panic" library procedure for Tcl;  
  *      individual applications will probably override this with  
  *      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.1.1.1 2001/06/13 04:44:06 dtashley Exp $  
  */  
   
 #include "tclInt.h"  
   
 /*  
  * The panicProc variable contains a pointer to an application  
  * specific panic procedure.  
  */  
   
 void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * Tcl_SetPanicProc --  
  *  
  *      Replace the default panic behavior with the specified functiion.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      Sets the panicProc variable.  
  *  
  *----------------------------------------------------------------------  
  */  
   
 void  
 Tcl_SetPanicProc(proc)  
     void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format));  
 {  
     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 (format, argList)  
     char *format;               /* Format string, suitable for passing to  
                                  * fprintf. */  
     va_list argList;            /* Variable argument list. */  
 {  
     char *arg1, *arg2, *arg3, *arg4;    /* Additional arguments (variable in  
                                          * number) to pass to fprintf. */  
     char *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) {  
         (void) (*panicProc)(format, arg1, arg2, arg3, arg4,  
                 arg5, arg6, arg7, arg8);  
     } else {  
         (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,  
                 arg7, arg8);  
         (void) fprintf(stderr, "\n");  
         (void) fflush(stderr);  
         abort();  
     }  
 }  
   
 /*  
  *----------------------------------------------------------------------  
  *  
  * panic --  
  *  
  *      Print an error message and kill the process.  
  *  
  * Results:  
  *      None.  
  *  
  * Side effects:  
  *      The process dies, entering the debugger if possible.  
  *  
  *----------------------------------------------------------------------  
  */  
   
         /* VARARGS ARGSUSED */  
 void  
 panic TCL_VARARGS_DEF(char *,arg1)  
 {  
     va_list argList;  
     char *format;  
   
     format = TCL_VARARGS_START(char *,arg1,argList);  
     Tcl_PanicVA(format, argList);  
     va_end (argList);  
 }  
   
   
 /* $History: tclpanic.c $  
  *  
  * *****************  Version 1  *****************  
  * User: Dtashley     Date: 1/02/01    Time: 1:37a  
  * Created in $/IjuScripter, IjuConsole/Source/Tcl Base  
  * Initial check-in.  
  */  
   
 /* End of TCLPANIC.C */  
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 */
Legend:
Removed from v.42  
changed lines
  Added in v.71
dashley@gmail.com
 ViewVC Help
Powered by ViewVC 1.1.25