Attachment "panic.patch" to
ticket [415648ffff]
added by
dgp
2001-04-18 07:29:43.
Index: generic/tcl.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.decls,v
retrieving revision 1.45
diff -u -r1.45 tcl.decls
--- generic/tcl.decls 2001/04/04 16:07:20 1.45
+++ generic/tcl.decls 2001/04/18 00:28:01
@@ -36,7 +36,7 @@
int exact, ClientData *clientDataPtr )
}
declare 2 generic {
- void Tcl_Panic(char *format, ...)
+ void Tcl_Panic(CONST char *format, ...)
}
declare 3 generic {
char * Tcl_Alloc(unsigned int size)
@@ -965,8 +965,8 @@
declare 277 generic {
Tcl_Pid Tcl_WaitPid(Tcl_Pid pid, int *statPtr, int options)
}
-declare 278 {unix win} {
- void Tcl_PanicVA(char *format, va_list argList)
+declare 278 generic {
+ void Tcl_PanicVA(CONST char *format, va_list argList)
}
declare 279 generic {
void Tcl_GetVersion(int *major, int *minor, int *patchLevel, int *type)
@@ -1572,8 +1572,7 @@
}
# These are not in MSL 2.1.2, so we need to export them from the
-# Tcl shared library. They are found in the compat directory
-# except the panic routine which is found in tclMacPanic.h.
+# Tcl shared library. They are found in the compat directory.
declare 7 mac {
int strncasecmp(CONST char *s1, CONST char *s2, size_t n)
Index: generic/tcl.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tcl.h,v
retrieving revision 1.88
diff -u -r1.88 tcl.h
--- generic/tcl.h 2001/04/04 16:07:20 1.88
+++ generic/tcl.h 2001/04/18 00:28:01
@@ -597,7 +597,7 @@
typedef int (Tcl_ObjCmdProc) _ANSI_ARGS_((ClientData clientData,
Tcl_Interp *interp, int objc, struct Tcl_Obj *CONST objv[]));
typedef int (Tcl_PackageInitProc) _ANSI_ARGS_((Tcl_Interp *interp));
-typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(char *, format));
+typedef void (Tcl_PanicProc) _ANSI_ARGS_(TCL_VARARGS(CONST char *, format));
typedef void (Tcl_TcpAcceptProc) _ANSI_ARGS_((ClientData callbackData,
Tcl_Channel chan, char *address, int port));
typedef void (Tcl_TimerProc) _ANSI_ARGS_((ClientData clientData));
Index: generic/tclDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclDecls.h,v
retrieving revision 1.47
diff -u -r1.47 tclDecls.h
--- generic/tclDecls.h 2001/04/04 16:07:20 1.47
+++ generic/tclDecls.h 2001/04/18 00:28:02
@@ -35,7 +35,7 @@
CONST char * name, CONST char * version,
int exact, ClientData * clientDataPtr));
/* 2 */
-EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(char *,format));
+EXTERN void Tcl_Panic _ANSI_ARGS_(TCL_VARARGS(CONST char *,format));
/* 3 */
EXTERN char * Tcl_Alloc _ANSI_ARGS_((unsigned int size));
/* 4 */
@@ -894,16 +894,9 @@
/* 277 */
EXTERN Tcl_Pid Tcl_WaitPid _ANSI_ARGS_((Tcl_Pid pid, int * statPtr,
int options));
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
-/* 278 */
-EXTERN void Tcl_PanicVA _ANSI_ARGS_((char * format,
- va_list argList));
-#endif /* UNIX */
-#ifdef __WIN32__
/* 278 */
-EXTERN void Tcl_PanicVA _ANSI_ARGS_((char * format,
+EXTERN void Tcl_PanicVA _ANSI_ARGS_((CONST char * format,
va_list argList));
-#endif /* __WIN32__ */
/* 279 */
EXTERN void Tcl_GetVersion _ANSI_ARGS_((int * major, int * minor,
int * patchLevel, int * type));
@@ -1372,7 +1365,7 @@
int (*tcl_PkgProvideEx) _ANSI_ARGS_((Tcl_Interp* interp, CONST char* name, CONST char* version, ClientData clientData)); /* 0 */
CONST char * (*tcl_PkgRequireEx) _ANSI_ARGS_((Tcl_Interp * interp, CONST char * name, CONST char * version, int exact, ClientData * clientDataPtr)); /* 1 */
- void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(char *,format)); /* 2 */
+ void (*tcl_Panic) _ANSI_ARGS_(TCL_VARARGS(CONST char *,format)); /* 2 */
char * (*tcl_Alloc) _ANSI_ARGS_((unsigned int size)); /* 3 */
void (*tcl_Free) _ANSI_ARGS_((char * ptr)); /* 4 */
char * (*tcl_Realloc) _ANSI_ARGS_((char * ptr, unsigned int size)); /* 5 */
@@ -1696,15 +1689,7 @@
void (*tcl_SetErrorCodeVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 275 */
int (*tcl_VarEvalVA) _ANSI_ARGS_((Tcl_Interp * interp, va_list argList)); /* 276 */
Tcl_Pid (*tcl_WaitPid) _ANSI_ARGS_((Tcl_Pid pid, int * statPtr, int options)); /* 277 */
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
- void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */
-#endif /* UNIX */
-#ifdef __WIN32__
- void (*tcl_PanicVA) _ANSI_ARGS_((char * format, va_list argList)); /* 278 */
-#endif /* __WIN32__ */
-#ifdef MAC_TCL
- void *reserved278;
-#endif /* MAC_TCL */
+ void (*tcl_PanicVA) _ANSI_ARGS_((CONST char * format, va_list argList)); /* 278 */
void (*tcl_GetVersion) _ANSI_ARGS_((int * major, int * minor, int * patchLevel, int * type)); /* 279 */
void (*tcl_InitMemory) _ANSI_ARGS_((Tcl_Interp * interp)); /* 280 */
Tcl_Channel (*tcl_StackChannel) _ANSI_ARGS_((Tcl_Interp * interp, Tcl_ChannelType * typePtr, ClientData instanceData, int mask, Tcl_Channel prevChan)); /* 281 */
@@ -3015,18 +3000,10 @@
#define Tcl_WaitPid \
(tclStubsPtr->tcl_WaitPid) /* 277 */
#endif
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
-#ifndef Tcl_PanicVA
-#define Tcl_PanicVA \
- (tclStubsPtr->tcl_PanicVA) /* 278 */
-#endif
-#endif /* UNIX */
-#ifdef __WIN32__
#ifndef Tcl_PanicVA
#define Tcl_PanicVA \
(tclStubsPtr->tcl_PanicVA) /* 278 */
#endif
-#endif /* __WIN32__ */
#ifndef Tcl_GetVersion
#define Tcl_GetVersion \
(tclStubsPtr->tcl_GetVersion) /* 279 */
Index: generic/tclInt.decls
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.decls,v
retrieving revision 1.23
diff -u -r1.23 tclInt.decls
--- generic/tclInt.decls 2000/09/28 06:38:21 1.23
+++ generic/tclInt.decls 2001/04/18 00:28:02
@@ -724,6 +724,9 @@
declare 25 mac {
int TclMacChmod(char *path, int mode)
}
+declare 26 mac {
+ void TclMacSetPanic(void)
+}
############################
# Windows specific internals
Index: generic/tclIntPlatDecls.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclIntPlatDecls.h,v
retrieving revision 1.9
diff -u -r1.9 tclIntPlatDecls.h
--- generic/tclIntPlatDecls.h 2000/07/26 01:30:59 1.9
+++ generic/tclIntPlatDecls.h 2001/04/18 00:28:02
@@ -194,6 +194,8 @@
/* 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 {
@@ -268,6 +270,7 @@
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;
@@ -520,6 +523,10 @@
#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.2
diff -u -r1.2 tclPanic.c
--- generic/tclPanic.c 1999/03/04 01:01:59 1.2
+++ generic/tclPanic.c 2001/04/18 00:28:02
@@ -2,8 +2,8 @@
* tclPanic.c --
*
* Source code for the "Tcl_Panic" library procedure for Tcl;
- * individual applications will probably override this with
- * an application-specific panic procedure.
+ * individual applications will probably call Tcl_SetPanicProc()
+ * to set an application-specific panic procedure.
*
* Copyright (c) 1988-1993 The Regents of the University of California.
* Copyright (c) 1994 Sun Microsystems, Inc.
@@ -22,7 +22,8 @@
* specific panic procedure.
*/
-void (*panicProc) _ANSI_ARGS_(TCL_VARARGS(char *,format)) = NULL;
+static Tcl_PanicProc *panicProc = NULL;
+
/*
*----------------------------------------------------------------------
@@ -42,7 +43,7 @@
void
Tcl_SetPanicProc(proc)
- void (*proc) _ANSI_ARGS_(TCL_VARARGS(char *,format));
+ Tcl_PanicProc *proc;
{
panicProc = proc;
}
@@ -65,7 +66,7 @@
void
Tcl_PanicVA (format, argList)
- char *format; /* Format string, suitable for passing to
+ CONST char *format; /* Format string, suitable for passing to
* fprintf. */
va_list argList; /* Variable argument list. */
{
@@ -97,7 +98,7 @@
/*
*----------------------------------------------------------------------
*
- * panic --
+ * Tcl_Panic --
*
* Print an error message and kill the process.
*
@@ -112,12 +113,12 @@
/* VARARGS ARGSUSED */
void
-panic TCL_VARARGS_DEF(char *,arg1)
+Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1)
{
va_list argList;
- char *format;
+ CONST char *format;
- format = TCL_VARARGS_START(char *,arg1,argList);
+ format = TCL_VARARGS_START(CONST char *,arg1,argList);
Tcl_PanicVA(format, argList);
va_end (argList);
}
Index: generic/tclStubInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclStubInit.c,v
retrieving revision 1.48
diff -u -r1.48 tclStubInit.c
--- generic/tclStubInit.c 2001/03/30 23:06:40 1.48
+++ generic/tclStubInit.c 2001/04/18 00:28:03
@@ -315,6 +315,7 @@
TclMacFOpenHack, /* 23 */
NULL, /* 24 */
TclMacChmod, /* 25 */
+ TclMacSetPanic, /* 26 */
#endif /* MAC_TCL */
};
@@ -673,15 +674,7 @@
Tcl_SetErrorCodeVA, /* 275 */
Tcl_VarEvalVA, /* 276 */
Tcl_WaitPid, /* 277 */
-#if !defined(__WIN32__) && !defined(MAC_TCL) /* UNIX */
- Tcl_PanicVA, /* 278 */
-#endif /* UNIX */
-#ifdef __WIN32__
Tcl_PanicVA, /* 278 */
-#endif /* __WIN32__ */
-#ifdef MAC_TCL
- NULL, /* 278 */
-#endif /* MAC_TCL */
Tcl_GetVersion, /* 279 */
Tcl_InitMemory, /* 280 */
Tcl_StackChannel, /* 281 */
Index: mac/tclMacAppInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacAppInit.c,v
retrieving revision 1.5
diff -u -r1.5 tclMacAppInit.c
--- mac/tclMacAppInit.c 1999/04/16 00:47:19 1.5
+++ mac/tclMacAppInit.c 2001/04/18 00:28:03
@@ -64,6 +64,7 @@
{
char *newArgv[2];
+ TclMacSetPanic();
if (MacintoshInit() != TCL_OK) {
Tcl_Exit(1);
}
Index: mac/tclMacBOAAppInit.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacBOAAppInit.c,v
retrieving revision 1.3
diff -u -r1.3 tclMacBOAAppInit.c
--- mac/tclMacBOAAppInit.c 1999/04/16 00:47:19 1.3
+++ mac/tclMacBOAAppInit.c 2001/04/18 00:28:03
@@ -75,6 +75,7 @@
{
char *newArgv[3];
+ TclMacSetPanic();
if (MacintoshInit() != TCL_OK) {
Tcl_Exit(1);
}
Index: mac/tclMacPanic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/mac/tclMacPanic.c,v
retrieving revision 1.2
diff -u -r1.2 tclMacPanic.c
--- mac/tclMacPanic.c 1998/09/14 18:40:05 1.2
+++ mac/tclMacPanic.c 2001/04/18 00:28:03
@@ -1,9 +1,9 @@
/*
* tclMacPanic.c --
*
- * Source code for the "panic" library procedure used in "Simple Shell";
- * other Mac applications will probably override this with a more robust
- * application-specific panic procedure.
+ * Source code for the "Tcl_Panic" library procedure used in "Simple
+ * Shell"; other Mac applications will probably call Tcl_SetPanicProc
+ * to set a more robust application-specific panic procedure.
*
* Copyright (c) 1993-1994 Lockheed Missle & Space Company, AI Center
* Copyright (c) 1995-1996 Sun Microsystems, Inc.
@@ -27,8 +27,6 @@
#include <stdio.h>
#include <stdlib.h>
-#include "tclInt.h"
-
/*
* constants for panic dialog
*/
@@ -40,56 +38,31 @@
#define ENTERCODE (0x03)
#define RETURNCODE (0x0D)
-/*
- * The panicProc variable contains a pointer to an application
- * specific panic procedure.
- */
+static void MacPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *, format));
-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;
-}
-
-/*
- *----------------------------------------------------------------------
- *
* MacPanic --
*
- * Displays panic info..
+ * Displays panic info, then aborts
*
* Results:
* None.
*
* Side effects:
- * Sets the panicProc variable.
+ * The process dies, entering the debugger if possible.
*
*----------------------------------------------------------------------
*/
+ /* VARARGS ARGSUSED */
static void
-MacPanic(
- char *msg) /* Text to show in panic dialog. */
+MacPanic TCL_VARARGS_DEF(CONST char *, arg1)
{
+ va_list varg;
+ char msg[256];
WindowRef macWinPtr, foundWinPtr;
Rect macRect;
Rect buttonRect = PANIC_BUTTON_RECT;
@@ -100,7 +73,10 @@
Handle stopIconHandle;
int part;
Boolean done = false;
-
+
+ va_start(varg, format);
+ vsprintf(msg, format, varg);
+ va_end(varg);
/*
* Put up an alert without using the Resource Manager (there may
@@ -195,41 +171,138 @@
/*
*----------------------------------------------------------------------
*
- * panic --
+ * TclMacSetPanic --
*
- * Print an error message and kill the process.
+ * Replace Tcl's default panic behavior with one more suitable for
+ * the Mac
*
* Results:
* None.
*
* Side effects:
- * The process dies, entering the debugger if possible.
+ * Tcl's panic proc is set.
*
*----------------------------------------------------------------------
*/
-#pragma ignore_oldstyle on
void
-panic(char * format, ...)
+TclMacSetPanic()
{
- va_list varg;
- char errorText[256];
-
+ 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
+ * remove the rest of this one.
+ */
+
+#include "tclInt.h"
+
+/*
+ * The panicProc variable contains a pointer to an application
+ * specific panic procedure.
+ */
+
+static Tcl_PanicProc *panicProc = NULL;
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_SetPanicProc --
+ *
+ * Replace the default panic behavior with the specified functiion.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * Sets the panicProc variable.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_SetPanicProc(proc)
+ Tcl_SetPanicProc *proc;
+{
+ panicProc = proc;
+}
+^L
+/*
+ *----------------------------------------------------------------------
+ *
+ * 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)
+ 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 *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) {
- va_start(varg, format);
-
- (void) (*panicProc)(format, varg);
-
- va_end(varg);
+ (void) (*panicProc)(format, arg1, arg2, arg3, arg4,
+ arg5, arg6, arg7, arg8);
} else {
- va_start(varg, format);
-
- vsprintf(errorText, format, varg);
-
- va_end(varg);
-
- MacPanic(errorText);
+ (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.
+ *
+ * Results:
+ * None.
+ *
+ * Side effects:
+ * The process dies, entering the debugger if possible.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ /* VARARGS ARGSUSED */
+void
+Tcl_Panic TCL_VARARGS_DEF(CONST char *,arg1)
+{
+ va_list argList;
+ CONST char *format;
+ format = TCL_VARARGS_START(CONST char *,arg1,argList);
+ Tcl_PanicVA(format, argList);
+ va_end (argList);
}
-#pragma ignore_oldstyle reset
+
Index: unix/mkLinks
===================================================================
RCS file: /cvsroot/tcl/tcl/unix/mkLinks,v
retrieving revision 1.24
diff -u -r1.24 mkLinks
--- unix/mkLinks 2001/04/06 23:29:17 1.24
+++ unix/mkLinks 2001/04/18 00:28:04
@@ -698,6 +698,18 @@
ln OpenTcp.3 Tcl_MakeTcpClientChannel.3
ln OpenTcp.3 Tcl_OpenTcpServer.3
fi
+if test -r Panic.3; then
+ rm -f Tcl_Panic.3
+ rm -f Tcl_PanicVA.3
+ rm -f Tcl_SetPanicProc.3
+ rm -f panic.3
+ rm -f panicVA.3
+ ln Panic.3 Tcl_Panic.3
+ ln Panic.3 Tcl_PanicVA.3
+ ln Panic.3 Tcl_SetPanicProc.3
+ ln Panic.3 panic.3
+ ln Panic.3 panicVA.3
+fi
if test -r ParseCmd.3; then
rm -f Tcl_ParseCommand.3
rm -f Tcl_ParseExpr.3
