summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.decls7
-rw-r--r--generic/tclDecls.h13
-rw-r--r--generic/tclEvent.c8
-rw-r--r--generic/tclIO.c6
-rw-r--r--generic/tclIOCmd.c4
-rw-r--r--generic/tclInt.decls9
-rw-r--r--generic/tclIntDecls.h16
-rw-r--r--generic/tclInterp.c6
-rw-r--r--generic/tclStubInit.c5
-rw-r--r--generic/tclTimer.c4
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);