Attachment "execErr.patch" to
ticket [536997ffff]
added by
msofer
2002-03-30 09:28:35.
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.51
diff -u -r1.51 tclExecute.c
--- generic/tclExecute.c 29 Mar 2002 21:01:12 -0000 1.51
+++ generic/tclExecute.c 30 Mar 2002 01:52:26 -0000
@@ -824,10 +824,6 @@
{
register Interp *iPtr = (Interp *) interp;
register ByteCode* codePtr; /* Tcl Internal type of bytecode. */
- int oldCount = iPtr->cmdCount; /* Used to tell whether any commands
- * at all were executed. */
- char *script;
- int numSrcBytes;
int result;
Namespace *namespacePtr;
@@ -882,94 +878,48 @@
panic("Tcl_EvalObj: compiled script jumped interps");
}
codePtr->compileEpoch = iPtr->compileEpoch;
+ goto doExecuteBC;
} else {
tclByteCodeType.freeIntRepProc(objPtr);
}
+ } else {
+ goto doExecuteBC;
}
}
- if (objPtr->typePtr != &tclByteCodeType) {
- iPtr->errorLine = 1;
- result = tclByteCodeType.setFromAnyProc(interp, objPtr);
- if (result != TCL_OK) {
- return result;
- }
- } else {
- codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- if (((Interp *) *codePtr->interpHandle != iPtr)
- || (codePtr->compileEpoch != iPtr->compileEpoch)) {
- (*tclByteCodeType.freeIntRepProc)(objPtr);
- iPtr->errorLine = 1;
- result = (*tclByteCodeType.setFromAnyProc)(interp, objPtr);
- if (result != TCL_OK) {
- return result;
- }
- }
+
+ iPtr->errorLine = 1;
+ result = tclByteCodeType.setFromAnyProc(interp, objPtr);
+ if (result != TCL_OK) {
+ return result;
}
codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
/*
- * Extract then reset the compilation flags in the interpreter.
* Resetting the flags must be done after any compilation.
*/
iPtr->evalFlags = 0;
/*
- * Execute the commands. If the code was compiled from an empty string,
- * don't bother executing the code.
- */
-
- numSrcBytes = codePtr->numSrcBytes;
- if ((numSrcBytes > 0) || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
- /*
- * Increment the code's ref count while it is being executed. If
- * afterwards no references to it remain, free the code.
- */
-
- codePtr->refCount++;
- iPtr->numLevels++;
- result = TclExecuteByteCode(interp, codePtr);
- iPtr->numLevels--;
- codePtr->refCount--;
- if (codePtr->refCount <= 0) {
- TclCleanupByteCode(codePtr);
- }
- } else {
- result = TCL_OK;
- }
-
- /*
- * If no commands at all were executed, check for asynchronous
- * handlers so that they at least get one change to execute.
- * This is needed to handle event loops written in Tcl with
- * empty bodies.
+ * Execute the commands. Increment the code's ref count while
+ * it is being executed. If afterwards no references to it remain,
+ * free the code. Set the interpreter's termOffset member to the
+ * offset of the character just after the last one executed. We
+ * approximate the offset of the last character executed by using
+ * the number of characters compiled.
*/
- if ((oldCount == iPtr->cmdCount) && Tcl_AsyncReady()) {
- result = Tcl_AsyncInvoke(interp, result);
-
-
- /*
- * If an error occurred, record information about what was being
- * executed when the error occurred.
- */
-
- if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- script = Tcl_GetStringFromObj(objPtr, &numSrcBytes);
- Tcl_LogCommandInfo(interp, script, script, numSrcBytes);
- }
+ doExecuteBC:
+ codePtr->refCount++;
+ iPtr->numLevels++;
+ result = TclExecuteByteCode(interp, codePtr);
+ iPtr->numLevels--;
+ iPtr->termOffset = codePtr->numSrcBytes;
+ codePtr->refCount--;
+ if (codePtr->refCount <= 0) {
+ TclCleanupByteCode(codePtr);
}
-
- /*
- * Set the interpreter's termOffset member to the offset of the
- * character just after the last one executed. We approximate the offset
- * of the last character executed by using the number of characters
- * compiled.
- */
-
- iPtr->termOffset = numSrcBytes;
iPtr->flags &= ~ERR_ALREADY_LOGGED;
-
return result;
}
@@ -1022,6 +972,7 @@
char *bytes;
int length;
long i = 0; /* Init. avoids compiler warning. */
+ int asyncCalled = 0;
#ifndef TCL_WIDE_INT_IS_LONG
Tcl_WideInt w;
#endif
@@ -1283,6 +1234,7 @@
Tcl_ResetResult(interp);
DECACHE_STACK_INFO();
result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
+ asyncCalled = 1;
CACHE_STACK_INFO();
/*
@@ -1398,6 +1350,7 @@
objPtr = POP_OBJECT();
DECACHE_STACK_INFO();
result = TclCompEvalObj(interp, objPtr);
+ asyncCalled = 1;
CACHE_STACK_INFO();
if (result == TCL_OK) {
/*
@@ -4383,15 +4336,34 @@
panic("TclExecuteByteCode execution failure: end stack top < start stack top");
}
+ done:
/*
* Free the catch stack array if malloc'ed storage was used.
*/
- done:
if (catchStackPtr != catchStackStorage) {
ckfree((char *) catchStackPtr);
}
eePtr->stackTop = initStackTop;
+
+ /*
+ * If no commands at all were executed, check for asynchronous
+ * handlers so that they at least get one change to execute.
+ * This is needed to handle event loops written in Tcl with
+ * empty bodies.
+ */
+
+ if ((!asyncCalled) && Tcl_AsyncReady()) {
+ result = Tcl_AsyncInvoke(interp, result);
+ if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
+ bytes = GetSrcInfoForPc(pc, codePtr, &length);
+ if (bytes != NULL) {
+ Tcl_LogCommandInfo(interp, codePtr->source, bytes, length);
+ iPtr->flags |= ERR_ALREADY_LOGGED;
+ }
+ }
+ }
+
return result;
#undef STATIC_CATCH_STACK_SIZE
}
