summaryrefslogtreecommitdiffstats
path: root/generic/tclExecute.c
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2003-11-16 00:49:20 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2003-11-16 00:49:20 (GMT)
commit10ef733f12d8356c8149674542195b702741fb57 (patch)
tree0ca93a479ec4c1eb68a2482ff755d5591112baeb /generic/tclExecute.c
parentecebf970f39a0b05f31b112c01c6d5b41434eed9 (diff)
downloadtcl-10ef733f12d8356c8149674542195b702741fb57.zip
tcl-10ef733f12d8356c8149674542195b702741fb57.tar.gz
tcl-10ef733f12d8356c8149674542195b702741fb57.tar.bz2
Miguel Sofer's patch (with small revisions) to make sure the bytecode engine
checks for async events fairly frequently. [Bug 746722]
Diffstat (limited to 'generic/tclExecute.c')
-rw-r--r--generic/tclExecute.c37
1 files changed, 36 insertions, 1 deletions
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index c642112..41f01fd 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.114 2003/11/14 20:44:44 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.115 2003/11/16 00:49:20 dkf Exp $
*/
#include "tclInt.h"
@@ -62,6 +62,16 @@ int errno;
#endif /* !DBL_MAX */
/*
+ * A mask (should be 2**n-1) that is used to work out when the
+ * bytecode engine should call Tcl_AsyncReady() to see whether there
+ * is a signal that needs handling.
+ */
+
+#ifndef ASYNC_CHECK_COUNT_MASK
+# define ASYNC_CHECK_COUNT_MASK 15
+#endif /* !ASYNC_CHECK_COUNT_MASK */
+
+/*
* Boolean flag indicating whether the Tcl bytecode interpreter has been
* initialized.
*/
@@ -1088,6 +1098,7 @@ TclExecuteByteCode(interp, codePtr)
int traceInstructions = (tclTraceExec == 3);
char cmdNameBuf[21];
#endif
+ int instructionCount = 0;
/*
* The execution uses a unified stack: first the catch stack, immediately
@@ -1202,6 +1213,21 @@ TclExecuteByteCode(interp, codePtr)
#ifdef TCL_COMPILE_STATS
iPtr->stats.instructionCount[*pc]++;
#endif
+
+ /*
+ * Check for asynchronous handlers [Bug 746722]; we
+ * do the check every 16th instruction.
+ */
+
+ if (!(instructionCount++ & ~ASYNC_CHECK_COUNT_MASK) && Tcl_AsyncReady()) {
+ DECACHE_STACK_INFO();
+ result = Tcl_AsyncInvoke(interp, result);
+ CACHE_STACK_INFO();
+ if (result == TCL_ERROR) {
+ goto checkForCatch;
+ }
+ }
+
switch (*pc) {
case INST_RETURN:
if (iPtr->returnOpts != iPtr->defaultReturnOpts) {
@@ -1210,6 +1236,7 @@ TclExecuteByteCode(interp, codePtr)
Tcl_IncrRefCount(iPtr->returnOpts);
}
result = TCL_RETURN;
+
case INST_DONE:
if (tosPtr <= eePtr->stackPtr + initStackTop) {
tosPtr--;
@@ -1493,6 +1520,14 @@ TclExecuteByteCode(interp, codePtr)
++*preservedStackRefCountPtr;
/*
+ * Reset the instructionCount variable, since we're about
+ * to check for async stuff anyway while processing
+ * TclEvalObjvInternal.
+ */
+
+ instructionCount = 0;
+
+ /*
* Finally, let TclEvalObjvInternal handle the command.
*/