diff options
author | dgp <dgp@noemail.net> | 2001-06-17 03:48:18 (GMT) |
---|---|---|
committer | dgp <dgp@noemail.net> | 2001-06-17 03:48:18 (GMT) |
commit | e9dbaf87d75b1996ac8cf4293c1cc3e675cf10e9 (patch) | |
tree | dbee9a76f5b1da8d4edc5ce3870efb502431c376 | |
parent | 353a2c1a6c2eafcf51ed44bb0ddeae88ee541380 (diff) | |
download | tcl-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-- | ChangeLog | 16 | ||||
-rw-r--r-- | generic/tclInt.decls | 5 | ||||
-rw-r--r-- | generic/tclInt.h | 4 | ||||
-rw-r--r-- | generic/tclIntPlatDecls.h | 9 | ||||
-rw-r--r-- | generic/tclPanic.c | 14 | ||||
-rw-r--r-- | generic/tclStubInit.c | 3 | ||||
-rw-r--r-- | mac/tclMacAppInit.c | 4 | ||||
-rw-r--r-- | mac/tclMacPanic.c | 89 | ||||
-rw-r--r-- | unix/tclUnixPort.h | 8 | ||||
-rw-r--r-- | win/tclWinPort.h | 8 |
10 files changed, 88 insertions, 72 deletions
@@ -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 |