summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@noemail.net>2001-06-17 03:48:18 (GMT)
committerdgp <dgp@noemail.net>2001-06-17 03:48:18 (GMT)
commite9dbaf87d75b1996ac8cf4293c1cc3e675cf10e9 (patch)
treedbee9a76f5b1da8d4edc5ce3870efb502431c376
parent353a2c1a6c2eafcf51ed44bb0ddeae88ee541380 (diff)
downloadtcl-e9dbaf87d75b1996ac8cf4293c1cc3e675cf10e9.zip
tcl-e9dbaf87d75b1996ac8cf4293c1cc3e675cf10e9.tar.gz
tcl-e9dbaf87d75b1996ac8cf4293c1cc3e675cf10e9.tar.bz2
* generic/tclInt.decls:
* generic/tclInt.h: * generic/tclPanic.c (Tcl_PanicVA): * mac/tclMacAppInit.c (main): * mac/tclMacPanic.c (TclpPanic): * unix/tclUnixPort.h: * win/tclWinPort.h: Replaced TclMacSetPanic with TclpPanic for setting a platform-specific panic handler. TclpPanic is NULL on Unix and Windows. Fixes broken wish on Mac due to earlier patches. [Patch 415648] * generic/tclIntPlatDecls.h: * generic/tclStubInit.c: `make gentubs` after above changes. FossilOrigin-Name: 0a5ecd45a142251ebb54658ab941b696e8cdf3d3
-rw-r--r--ChangeLog16
-rw-r--r--generic/tclInt.decls5
-rw-r--r--generic/tclInt.h4
-rw-r--r--generic/tclIntPlatDecls.h9
-rw-r--r--generic/tclPanic.c14
-rw-r--r--generic/tclStubInit.c3
-rw-r--r--mac/tclMacAppInit.c4
-rw-r--r--mac/tclMacPanic.c89
-rw-r--r--unix/tclUnixPort.h8
-rw-r--r--win/tclWinPort.h8
10 files changed, 88 insertions, 72 deletions
diff --git a/ChangeLog b/ChangeLog
index fc20053..7cf1714 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,19 @@
+2001-06-16 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclInt.decls:
+ * generic/tclInt.h:
+ * generic/tclPanic.c (Tcl_PanicVA):
+ * mac/tclMacAppInit.c (main):
+ * mac/tclMacPanic.c (TclpPanic):
+ * unix/tclUnixPort.h:
+ * win/tclWinPort.h: Replaced TclMacSetPanic with TclpPanic
+ for setting a platform-specific panic handler. TclpPanic
+ is NULL on Unix and Windows. Fixes broken wish on Mac due
+ to earlier patches. [Patch 415648]
+
+ * generic/tclIntPlatDecls.h:
+ * generic/tclStubInit.c: `make gentubs` after above changes.
+
2001-06-13 Don Porter <dgp@users.sourceforge.net>
* mac/tclMacAppInit.c (main, Macintosh_Init):
diff --git a/generic/tclInt.decls b/generic/tclInt.decls
index 8835119..4894d2d 100644
--- a/generic/tclInt.decls
+++ b/generic/tclInt.decls
@@ -10,7 +10,7 @@
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
-# RCS: @(#) $Id: tclInt.decls,v 1.27 2001/06/08 20:06:11 dgp Exp $
+# RCS: @(#) $Id: tclInt.decls,v 1.28 2001/06/17 03:48:19 dgp Exp $
library tcl
@@ -725,9 +725,6 @@ declare 23 mac {
declare 25 mac {
int TclMacChmod(char *path, int mode)
}
-declare 26 mac {
- void TclMacSetPanic(void)
-}
############################
# Windows specific internals
diff --git a/generic/tclInt.h b/generic/tclInt.h
index e0ded8b..7af3c65 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.55 2001/05/26 01:25:59 msofer Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.56 2001/06/17 03:48:19 dgp Exp $
*/
#ifndef _TCLINT
@@ -1835,6 +1835,8 @@ EXTERN int TclpMatchFiles _ANSI_ARGS_((Tcl_Interp *interp,
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,
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index ce5e87c..8c690c8 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -9,7 +9,7 @@
* Copyright (c) 1998-1999 by Scriptics Corporation.
* All rights reserved.
*
- * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.10 2001/06/08 20:06:11 dgp Exp $
+ * RCS: @(#) $Id: tclIntPlatDecls.h,v 1.11 2001/06/17 03:48:19 dgp Exp $
*/
#ifndef _TCLINTPLATDECLS
@@ -194,8 +194,6 @@ EXTERN FILE * TclMacFOpenHack _ANSI_ARGS_((CONST char * path,
/* 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 @@ typedef struct TclIntPlatStubs {
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;
@@ -524,10 +521,6 @@ extern TclIntPlatStubs *tclIntPlatStubsPtr;
#define TclMacChmod \
(tclIntPlatStubsPtr->tclMacChmod) /* 25 */
#endif
-#ifndef TclMacSetPanic
-#define TclMacSetPanic \
- (tclIntPlatStubsPtr->tclMacSetPanic) /* 26 */
-#endif
#endif /* MAC_TCL */
#endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index 4e4b06c..5b9125e 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -12,10 +12,11 @@
* 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.3 2001/06/08 20:06:11 dgp Exp $
+ * RCS: @(#) $Id: tclPanic.c,v 1.4 2001/06/17 03:48:19 dgp Exp $
*/
#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;
+
/*
*----------------------------------------------------------------------
@@ -86,6 +95,9 @@ Tcl_PanicVA (format, argList)
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,
arg7, arg8);
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index c20a13c..cf8b8b9 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -8,7 +8,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclStubInit.c,v 1.51 2001/06/08 20:06:11 dgp Exp $
+ * RCS: @(#) $Id: tclStubInit.c,v 1.52 2001/06/17 03:48:19 dgp Exp $
*/
#include "tclInt.h"
@@ -315,7 +315,6 @@ TclIntPlatStubs tclIntPlatStubs = {
TclMacFOpenHack, /* 23 */
NULL, /* 24 */
TclMacChmod, /* 25 */
- TclMacSetPanic, /* 26 */
#endif /* MAC_TCL */
};
diff --git a/mac/tclMacAppInit.c b/mac/tclMacAppInit.c
index 1e83125..678198d 100644
--- a/mac/tclMacAppInit.c
+++ b/mac/tclMacAppInit.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacAppInit.c,v 1.7 2001/06/14 00:48:51 dgp Exp $
+ * RCS: @(#) $Id: tclMacAppInit.c,v 1.8 2001/06/17 03:48:19 dgp Exp $
*/
#include "tcl.h"
@@ -205,8 +205,6 @@ MacintoshInit()
#endif
- TclMacSetPanic();
-
Tcl_MacSetEventProc((Tcl_MacConvertEventPtr) SIOUXHandleOneEvent);
/* No problems with initialization */
diff --git a/mac/tclMacPanic.c b/mac/tclMacPanic.c
index 896a633..0987fa3 100644
--- a/mac/tclMacPanic.c
+++ b/mac/tclMacPanic.c
@@ -11,7 +11,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclMacPanic.c,v 1.4 2001/06/14 00:48:51 dgp Exp $
+ * RCS: @(#) $Id: tclMacPanic.c,v 1.5 2001/06/17 03:48:19 dgp Exp $
*/
@@ -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 @@ static void MacPanic _ANSI_ARGS_(TCL_VARARGS(CONST char *, format));
/* 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 @@ MacPanic TCL_VARARGS_DEF(CONST char *, format)
}
/*
- *----------------------------------------------------------------------
- *
- * 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 @@ TclMacSetPanic()
*/
#include "tclInt.h"
+#include "tclPort.h"
/*
* The panicProc variable contains a pointer to an application
@@ -210,6 +186,14 @@ TclMacSetPanic()
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 @@ static Tcl_PanicProc *panicProc = NULL;
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 @@ Tcl_PanicVA (format, argList)
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)
{
diff --git a/unix/tclUnixPort.h b/unix/tclUnixPort.h
index d5b683c..1e7985d 100644
--- a/unix/tclUnixPort.h
+++ b/unix/tclUnixPort.h
@@ -19,7 +19,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclUnixPort.h,v 1.16 2000/07/26 01:28:11 davidg Exp $
+ * RCS: @(#) $Id: tclUnixPort.h,v 1.17 2001/06/17 03:48:19 dgp Exp $
*/
#ifndef _TCLUNIXPORT
@@ -439,6 +439,12 @@ extern char **environ;
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
diff --git a/win/tclWinPort.h b/win/tclWinPort.h
index bb6ec27..5ec1383 100644
--- a/win/tclWinPort.h
+++ b/win/tclWinPort.h
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclWinPort.h,v 1.13 2000/11/16 21:38:52 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclWinPort.h,v 1.14 2001/06/17 03:48:19 dgp Exp $
*/
#ifndef _TCLWINPORT
@@ -346,6 +346,12 @@ typedef float *TCHAR;
#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