diff options
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tcl.decls | 7 | ||||
-rw-r--r-- | generic/tclDecls.h | 13 | ||||
-rw-r--r-- | generic/tclEvent.c | 8 | ||||
-rw-r--r-- | generic/tclIO.c | 6 | ||||
-rw-r--r-- | generic/tclIOCmd.c | 4 | ||||
-rw-r--r-- | generic/tclInt.decls | 9 | ||||
-rw-r--r-- | generic/tclIntDecls.h | 16 | ||||
-rw-r--r-- | generic/tclInterp.c | 6 | ||||
-rw-r--r-- | generic/tclStubInit.c | 5 | ||||
-rw-r--r-- | generic/tclTimer.c | 4 |
10 files changed, 44 insertions, 34 deletions
diff --git a/generic/tcl.decls b/generic/tcl.decls index bdfe02c..9bf31ff 100644 --- a/generic/tcl.decls +++ b/generic/tcl.decls @@ -12,7 +12,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: tcl.decls,v 1.157 2008/12/05 21:38:47 dkf Exp $ +# RCS: @(#) $Id: tcl.decls,v 1.158 2008/12/09 20:16:29 dgp Exp $ library tcl @@ -2217,6 +2217,11 @@ declare 608 generic { int Tcl_InterpActive(Tcl_Interp *interp) } +# TIP 337 +declare 609 generic { + void Tcl_BackgroundException(Tcl_Interp *interp, int code) +} + ############################################################################## # Define the platform specific public Tcl interface. These functions are only diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 7e1c6fd..525b613 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -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: tclDecls.h,v 1.159 2008/12/05 21:40:38 dkf Exp $ + * RCS: @(#) $Id: tclDecls.h,v 1.160 2008/12/09 20:16:29 dgp Exp $ */ #ifndef _TCLDECLS @@ -3681,6 +3681,12 @@ EXTERN void Tcl_TransferResult (Tcl_Interp * sourceInterp, /* 608 */ EXTERN int Tcl_InterpActive (Tcl_Interp * interp); #endif +#ifndef Tcl_BackgroundException_TCL_DECLARED +#define Tcl_BackgroundException_TCL_DECLARED +/* 609 */ +EXTERN void Tcl_BackgroundException (Tcl_Interp * interp, + int code); +#endif typedef struct TclStubHooks { const struct TclPlatStubs *tclPlatStubs; @@ -4349,6 +4355,7 @@ typedef struct TclStubs { void (*tcl_SetErrorLine) (Tcl_Interp * interp, int value); /* 606 */ void (*tcl_TransferResult) (Tcl_Interp * sourceInterp, int result, Tcl_Interp * targetInterp); /* 607 */ int (*tcl_InterpActive) (Tcl_Interp * interp); /* 608 */ + void (*tcl_BackgroundException) (Tcl_Interp * interp, int code); /* 609 */ } TclStubs; #if defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) @@ -6857,6 +6864,10 @@ extern const TclStubs *tclStubsPtr; #define Tcl_InterpActive \ (tclStubsPtr->tcl_InterpActive) /* 608 */ #endif +#ifndef Tcl_BackgroundException +#define Tcl_BackgroundException \ + (tclStubsPtr->tcl_BackgroundException) /* 609 */ +#endif #endif /* defined(USE_TCL_STUBS) && !defined(USE_TCL_STUB_PROCS) */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 203dc5a..cbb0aad 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclEvent.c,v 1.85 2008/10/26 18:34:04 dkf Exp $ + * RCS: @(#) $Id: tclEvent.c,v 1.86 2008/12/09 20:16:29 dgp Exp $ */ #include "tclInt.h" @@ -140,10 +140,10 @@ Tcl_BackgroundError( Tcl_Interp *interp) /* Interpreter in which an error has * occurred. */ { - TclBackgroundException(interp, TCL_ERROR); + Tcl_BackgroundException(interp, TCL_ERROR); } void -TclBackgroundException( +Tcl_BackgroundException( Tcl_Interp *interp, /* Interpreter in which an exception has * occurred. */ int code) /* The exception code value */ @@ -353,7 +353,7 @@ TclDefaultBgErrorHandlerObjCmd( if (code == TCL_OK) { /* * Somehow we got to exception handling with no exception. - * (Pass TCL_OK to TclBackgroundException()?) + * (Pass TCL_OK to Tcl_BackgroundException()?) * Just return without doing anything. */ return TCL_OK; diff --git a/generic/tclIO.c b/generic/tclIO.c index 1a2bbfb..09ca6fa 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -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: tclIO.c,v 1.152 2008/12/09 14:09:14 dkf Exp $ + * RCS: @(#) $Id: tclIO.c,v 1.153 2008/12/09 20:16:29 dgp Exp $ */ #include "tclInt.h" @@ -8307,7 +8307,7 @@ TclChannelEventScriptInvoker( if (chanPtr->typePtr != NULL) { DeleteScriptRecord(interp, chanPtr, mask); } - TclBackgroundException(interp, result); + Tcl_BackgroundException(interp, result); } Tcl_Release(interp); } @@ -8812,7 +8812,7 @@ CopyData( } code = Tcl_EvalObjEx(interp, cmdPtr, TCL_EVAL_GLOBAL); if (code != TCL_OK) { - TclBackgroundException(interp, code); + Tcl_BackgroundException(interp, code); result = TCL_ERROR; } TclDecrRefCount(cmdPtr); diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index dbc9bb1..dbf6b2c 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.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: tclIOCmd.c,v 1.59 2008/10/16 22:34:19 nijtmans Exp $ + * RCS: @(#) $Id: tclIOCmd.c,v 1.60 2008/12/09 20:16:29 dgp Exp $ */ #include "tclInt.h" @@ -1334,7 +1334,7 @@ AcceptCallbackProc( result = Tcl_VarEval(interp, script, " ", Tcl_GetChannelName(chan), " ", address, " ", portBuf, NULL); if (result != TCL_OK) { - TclBackgroundException(interp, result); + Tcl_BackgroundException(interp, result); Tcl_UnregisterChannel(interp, chan); } diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 221fb34..1853c5c 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -13,7 +13,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.129 2008/10/22 20:23:59 nijtmans Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.130 2008/12/09 20:16:29 dgp Exp $ library tcl @@ -933,9 +933,10 @@ declare 235 generic { } -declare 236 generic { - void TclBackgroundException(Tcl_Interp *interp, int code) -} +# TIP 337 made this one public +#declare 236 generic { +# void TclBackgroundException(Tcl_Interp *interp, int code) +#} # TIP #285: Script cancellation support. declare 237 generic { diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index ab08e3b..a511988 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.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: tclIntDecls.h,v 1.125 2008/10/22 20:23:59 nijtmans Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.126 2008/12/09 20:16:30 dgp Exp $ */ #ifndef _TCLINTDECLS @@ -1059,12 +1059,7 @@ EXTERN Var * TclVarHashCreateVar (TclVarHashTable * tablePtr, EXTERN void TclInitVarHashTable (TclVarHashTable * tablePtr, Namespace * nsPtr); #endif -#ifndef TclBackgroundException_TCL_DECLARED -#define TclBackgroundException_TCL_DECLARED -/* 236 */ -EXTERN void TclBackgroundException (Tcl_Interp * interp, - int code); -#endif +/* Slot 236 is reserved */ #ifndef TclResetCancellation_TCL_DECLARED #define TclResetCancellation_TCL_DECLARED /* 237 */ @@ -1369,7 +1364,7 @@ typedef struct TclIntStubs { void (*tclGetSrcInfoForPc) (CmdFrame * contextPtr); /* 233 */ Var * (*tclVarHashCreateVar) (TclVarHashTable * tablePtr, const char * key, int * newPtr); /* 234 */ void (*tclInitVarHashTable) (TclVarHashTable * tablePtr, Namespace * nsPtr); /* 235 */ - void (*tclBackgroundException) (Tcl_Interp * interp, int code); /* 236 */ + void *reserved236; int (*tclResetCancellation) (Tcl_Interp * interp, int force); /* 237 */ int (*tclNRInterpProc) (ClientData clientData, Tcl_Interp * interp, int objc, Tcl_Obj *const objv[]); /* 238 */ int (*tclNRInterpProcCore) (Tcl_Interp * interp, Tcl_Obj * procNameObj, int skip, ProcErrorProc errorProc); /* 239 */ @@ -2110,10 +2105,7 @@ extern const TclIntStubs *tclIntStubsPtr; #define TclInitVarHashTable \ (tclIntStubsPtr->tclInitVarHashTable) /* 235 */ #endif -#ifndef TclBackgroundException -#define TclBackgroundException \ - (tclIntStubsPtr->tclBackgroundException) /* 236 */ -#endif +/* Slot 236 is reserved */ #ifndef TclResetCancellation #define TclResetCancellation \ (tclIntStubsPtr->tclResetCancellation) /* 237 */ diff --git a/generic/tclInterp.c b/generic/tclInterp.c index 939d3a0..ac8cbb9 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -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: tclInterp.c,v 1.98 2008/12/05 14:27:36 dkf Exp $ + * RCS: @(#) $Id: tclInterp.c,v 1.99 2008/12/09 20:16:30 dgp Exp $ */ #include "tclInt.h" @@ -3765,7 +3765,7 @@ TimeLimitCallback( code = Tcl_LimitCheck(interp); if (code != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (while waiting for event)"); - TclBackgroundException(interp, code); + Tcl_BackgroundException(interp, code); } Tcl_Release(interp); } @@ -3933,7 +3933,7 @@ CallScriptLimitCallback( code = Tcl_EvalObjEx(limitCBPtr->interp, limitCBPtr->scriptObj, TCL_EVAL_GLOBAL); if (code != TCL_OK && !Tcl_InterpDeleted(limitCBPtr->interp)) { - TclBackgroundException(limitCBPtr->interp, code); + Tcl_BackgroundException(limitCBPtr->interp, code); } Tcl_Release(limitCBPtr->interp); } diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 6fdbc0d..f858b14 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.170 2008/12/05 21:40:38 dkf Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.171 2008/12/09 20:16:30 dgp Exp $ */ #include "tclInt.h" @@ -305,7 +305,7 @@ static const TclIntStubs tclIntStubs = { TclGetSrcInfoForPc, /* 233 */ TclVarHashCreateVar, /* 234 */ TclInitVarHashTable, /* 235 */ - TclBackgroundException, /* 236 */ + NULL, /* 236 */ TclResetCancellation, /* 237 */ TclNRInterpProc, /* 238 */ TclNRInterpProcCore, /* 239 */ @@ -1134,6 +1134,7 @@ static const TclStubs tclStubs = { Tcl_SetErrorLine, /* 606 */ Tcl_TransferResult, /* 607 */ Tcl_InterpActive, /* 608 */ + Tcl_BackgroundException, /* 609 */ }; /* !END!: Do not edit above this line. */ diff --git a/generic/tclTimer.c b/generic/tclTimer.c index e254830..03e01fa 100644 --- a/generic/tclTimer.c +++ b/generic/tclTimer.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: tclTimer.c,v 1.36 2008/10/26 18:34:04 dkf Exp $ + * RCS: @(#) $Id: tclTimer.c,v 1.37 2008/12/09 20:16:30 dgp Exp $ */ #include "tclInt.h" @@ -1177,7 +1177,7 @@ AfterProc( result = Tcl_EvalObjEx(interp, afterPtr->commandPtr, TCL_EVAL_GLOBAL); if (result != TCL_OK) { Tcl_AddErrorInfo(interp, "\n (\"after\" script)"); - TclBackgroundException(interp, result); + Tcl_BackgroundException(interp, result); } Tcl_Release((ClientData) interp); |