Attachment "tclppanic.patch" to
ticket [415648ffff]
added by
dgp
2001-06-16 06:33:52.
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.27
diff -u -r1.27 tclInt.decls
--- generic/tclInt.decls 2001/06/08 20:06:11 1.27
+++ generic/tclInt.decls 2001/06/15 23:28:53
@@ -725,9 +725,6 @@
declare 25 mac {
int TclMacChmod(char *path, int mode)
}
-declare 26 mac {
- void TclMacSetPanic(void)
-}
############################
# Windows specific internals
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.55
diff -u -r1.55 tclInt.h
--- generic/tclInt.h 2001/05/26 01:25:59 1.55
+++ generic/tclInt.h 2001/06/15 23:28:53
@@ -1835,6 +1835,8 @@
EXTERN Tcl_Channel TclpOpenFileChannel _ANSI_ARGS_((Tcl_Interp *interp,
char *fileName, char *modeString,
int permissions));
+EXTERN void TclpPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *,
+ format));
EXTERN char * TclpReadlink _ANSI_ARGS_((CONST char *fileName,
Tcl_DString *linkPtr));
EXTERN char * TclpRealloc _ANSI_ARGS_((char *ptr,
Index: generic/tclIntPlatDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntPlatDecls.h,v
retrieving revision 1.10
diff -u -r1.10 tclIntPlatDecls.h
--- generic/tclIntPlatDecls.h 2001/06/08 20:06:11 1.10
+++ generic/tclIntPlatDecls.h 2001/06/15 23:28:53
@@ -194,8 +194,6 @@
/* Slot 24 is reserved */
/* 25 */
EXTERN int TclMacChmod _ANSI_ARGS_((char * path, int mode));
-/* 26 */
-EXTERN void TclMacSetPanic _ANSI_ARGS_((void));
#endif /* MAC_TCL */
typedef struct TclIntPlatStubs {
@@ -270,7 +268,6 @@
FILE * (*tclMacFOpenHack) _ANSI_ARGS_((CONST char * path, CONST char * mode)); /* 23 */
void *reserved24;
int (*tclMacChmod) _ANSI_ARGS_((char * path, int mode)); /* 25 */
- void (*tclMacSetPanic) _ANSI_ARGS_((void)); /* 26 */
#endif /* MAC_TCL */
} TclIntPlatStubs;
@@ -523,10 +520,6 @@
#ifndef TclMacChmod
#define TclMacChmod \
(tclIntPlatStubsPtr->tclMacChmod) /* 25 */
-#endif
-#ifndef TclMacSetPanic
-#define TclMacSetPanic \
- (tclIntPlatStubsPtr->tclMacSetPanic) /* 26 */
#endif
#endif /* MAC_TCL */
Index: generic/tclPanic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclPanic.c,v
retrieving revision 1.3
diff -u -r1.3 tclPanic.c
--- generic/tclPanic.c 2001/06/08 20:06:11 1.3
+++ generic/tclPanic.c 2001/06/15 23:28:53
@@ -16,6 +16,7 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
/*
* The panicProc variable contains a pointer to an application
@@ -24,6 +25,14 @@
static Tcl_PanicProc *panicProc = NULL;
+/*
+ * The platformPanicProc variable contains a pointer to a platform
+ * specific panic procedure, if any. ( TclpPanic may be NULL via
+ * a macro. )
+ */
+
+static Tcl_PanicProc * CONST platformPanicProc = TclpPanic;
+
/*
*----------------------------------------------------------------------
@@ -85,6 +94,9 @@
if (panicProc != NULL) {
(void) (*panicProc)(format, arg1, arg2, arg3, arg4,
+ arg5, arg6, arg7, arg8);
+ } else if (platformPanicProc != NULL) {
+ (void) (*platformPanicProc)(format, arg1, arg2, arg3, arg4,
arg5, arg6, arg7, arg8);
} else {
(void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.51
diff -u -r1.51 tclStubInit.c
--- generic/tclStubInit.c 2001/06/08 20:06:11 1.51
+++ generic/tclStubInit.c 2001/06/15 23:28:53
@@ -315,7 +315,6 @@
TclMacFOpenHack, /* 23 */
NULL, /* 24 */
TclMacChmod, /* 25 */
- TclMacSetPanic, /* 26 */
#endif /* MAC_TCL */
};
Index: mac/tclMacAppInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacAppInit.c,v
retrieving revision 1.7
diff -u -r1.7 tclMacAppInit.c
--- mac/tclMacAppInit.c 2001/06/14 00:48:51 1.7
+++ mac/tclMacAppInit.c 2001/06/15 23:28:53
@@ -205,8 +205,6 @@
#endif
- TclMacSetPanic();
-
Tcl_MacSetEventProc((Tcl_MacConvertEventPtr) SIOUXHandleOneEvent);
/* No problems with initialization */
Index: mac/tclMacPanic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacPanic.c,v
retrieving revision 1.4
diff -u -r1.4 tclMacPanic.c
--- mac/tclMacPanic.c 2001/06/14 00:48:51 1.4
+++ mac/tclMacPanic.c 2001/06/15 23:28:54
@@ -41,13 +41,11 @@
#define ENTERCODE (0x03)
#define RETURNCODE (0x0D)
-static void MacPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *, format));
-
/*
*----------------------------------------------------------------------
*
- * MacPanic --
+ * TclpPanic --
*
* Displays panic info, then aborts
*
@@ -62,7 +60,7 @@
/* VARARGS ARGSUSED */
static void
-MacPanic TCL_VARARGS_DEF(CONST char *, format)
+TclpPanic TCL_VARARGS_DEF(CONST char *, format)
{
va_list varg;
char msg[256];
@@ -172,29 +170,6 @@
}
/*
- *----------------------------------------------------------------------
- *
- * TclMacSetPanic --
- *
- * Replace Tcl's default panic behavior with one more suitable for
- * the Mac
- *
- * Results:
- * None.
- *
- * Side effects:
- * Tcl's panic proc is set.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclMacSetPanic()
-{
- Tcl_SetPanicProc(MacPanic);
-}
-
-/*
* NOTE: The rest of this file is *identical* to the file
* generic/tclPanic.c. Someone with the right set of development tools on
* the Mac should be able to build the Tcl library using that file, and
@@ -202,6 +177,7 @@
*/
#include "tclInt.h"
+#include "tclPort.h"
/*
* The panicProc variable contains a pointer to an application
@@ -210,6 +186,14 @@
static Tcl_PanicProc *panicProc = NULL;
+/*
+ * The platformPanicProc variable contains a pointer to a platform
+ * specific panic procedure, if any. ( TclpPanic may be NULL via
+ * a macro. )
+ */
+
+static Tcl_PanicProc * CONST platformPanicProc = TclpPanic;
+
/*
*----------------------------------------------------------------------
@@ -229,35 +213,35 @@
void
Tcl_SetPanicProc(proc)
- Tcl_SetPanicProc *proc;
+ Tcl_PanicProc *proc;
{
panicProc = proc;
}
-^L
+
/*
*----------------------------------------------------------------------
*
* Tcl_PanicVA --
*
- * Print an error message and kill the process.
+ * Print an error message and kill the process.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * The process dies, entering the debugger if possible.
+ * The process dies, entering the debugger if possible.
*
*----------------------------------------------------------------------
*/
void
Tcl_PanicVA (format, argList)
- CONST char *format; /* Format string, suitable for passing to
- * fprintf. */
- va_list argList; /* Variable argument list. */
+ CONST 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 *arg1, *arg2, *arg3, *arg4; /* Additional arguments (variable in
+ * number) to pass to fprintf. */
char *arg5, *arg6, *arg7, *arg8;
arg1 = va_arg(argList, char *);
@@ -268,36 +252,39 @@
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);
+ (void) (*panicProc)(format, arg1, arg2, arg3, arg4,
+ arg5, arg6, arg7, arg8);
+ } else if (platformPanicProc != NULL) {
+ (void) (*platformPanicProc)(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();
+ (void) fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6,
+ arg7, arg8);
+ (void) fprintf(stderr, "\n");
+ (void) fflush(stderr);
+ abort();
}
}
-^L
+
/*
*----------------------------------------------------------------------
*
* Tcl_Panic --
*
- * Print an error message and kill the process.
+ * Print an error message and kill the process.
*
* Results:
- * None.
+ * None.
*
* Side effects:
- * The process dies, entering the debugger if possible.
+ * The process dies, entering the debugger if possible.
*
*----------------------------------------------------------------------
*/
- /* VARARGS ARGSUSED */
+ /* VARARGS ARGSUSED */
void
Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1)
{
Index: unix/tclUnixPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/tclUnixPort.h,v
retrieving revision 1.16
diff -u -r1.16 tclUnixPort.h
--- unix/tclUnixPort.h 2000/07/26 01:28:11 1.16
+++ unix/tclUnixPort.h 2001/06/15 23:28:54
@@ -439,6 +439,12 @@
extern double strtod();
/*
+ * There is no platform-specific panic routine for Unix in the Tcl internals.
+ */
+
+#define TclpPanic ((Tcl_PanicProc *) NULL)
+
+/*
*---------------------------------------------------------------------------
* The following macros and declarations represent the interface between
* generic and unix-specific parts of Tcl. Some of the macros may override
Index: win/tclWinPort.h
===================================================================
RCS file: /cvsroot/tcl/tcl/win/tclWinPort.h,v
retrieving revision 1.13
diff -u -r1.13 tclWinPort.h
--- win/tclWinPort.h 2000/11/16 21:38:52 1.13
+++ win/tclWinPort.h 2001/06/15 23:28:54
@@ -346,6 +346,12 @@
#endif /* _MSC_VER || __MINGW32__ */
/*
+ * There is no platform-specific panic routine for Windows in the Tcl internals.
+ */
+
+#define TclpPanic ((Tcl_PanicProc *) NULL)
+
+/*
*---------------------------------------------------------------------------
* The following macros and declarations represent the interface between
* generic and windows-specific parts of Tcl. Some of the macros may
