diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2004-03-30 16:22:11 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2004-03-30 16:22:11 (GMT) |
commit | d7342e95b8185e47c027ad6a573b4242e5ca67c9 (patch) | |
tree | 513ad8ee17cc642e66403897bbb9188df51ee60b /generic | |
parent | 18687b718a2c5a3bc06cd3aea1c081fa25827009 (diff) | |
download | tcl-d7342e95b8185e47c027ad6a573b4242e5ca67c9.zip tcl-d7342e95b8185e47c027ad6a573b4242e5ca67c9.tar.gz tcl-d7342e95b8185e47c027ad6a573b4242e5ca67c9.tar.bz2 |
* generic/tclCompile.c: New instruction code INST_START_CMD
* generic/tclCompile.h: that allows checking the bytecode's
* generic/tclExecute.c: validity [Bug 729692] and the interp's
* tests/interp.test (18.9): readyness [Bug 495830] before running
* tests/proc.test (7.1): the command. It also changes the
* tests/rename.test (6.1): mechanics of the async tests in TEBC,
doing it now at command start instead of every 16 instructions.
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclCompile.c | 22 | ||||
-rw-r--r-- | generic/tclCompile.h | 6 | ||||
-rw-r--r-- | generic/tclExecute.c | 80 |
3 files changed, 71 insertions, 37 deletions
diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 6230e06..def4e4d 100644 --- a/generic/tclCompile.c +++ b/generic/tclCompile.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: tclCompile.c,v 1.59 2004/03/29 02:09:46 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.60 2004/03/30 16:22:11 msofer Exp $ */ #include "tclInt.h" @@ -282,6 +282,9 @@ InstructionDesc tclInstructionTable[] = { /* List Index: push (lindex stktop op4) */ {"listRangeImm", 9, 0, 2, {OPERAND_IDX4, OPERAND_IDX4}}, /* List Range: push (lrange stktop op4 op4) */ + + {"startCommand", 5, 0, 1, {OPERAND_UINT4}}, + /* Start of bytecoded command: op is the length of the cmd's code */ {0} }; @@ -1056,9 +1059,26 @@ TclCompileScript(interp, script, numBytes, envPtr) unsigned int savedCodeNext = envPtr->codeNext - envPtr->codeStart; + /* + * Mark the start of the command; the proper + * bytecode length will be updated later. + */ + + TclEmitInstInt4(INST_START_CMD, 0, envPtr); + code = (*(cmdPtr->compileProc))(interp, &parse, envPtr); + if (code == TCL_OK) { + /* + * Fix the bytecode length. + */ + unsigned char *fixPtr = envPtr->codeStart + savedCodeNext + 1; + unsigned int fixLen = envPtr->codeNext - envPtr->codeStart + - savedCodeNext; + + TclStoreInt4AtPtr(fixLen, fixPtr); + goto finishCommand; } else if (code == TCL_OUT_LINE_COMPILE) { /* diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 5f46b78..1d6b498 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.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: tclCompile.h,v 1.42 2004/01/20 15:49:54 dkf Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.43 2004/03/30 16:22:21 msofer Exp $ */ #ifndef _TCLCOMPILATION @@ -543,8 +543,10 @@ typedef struct ByteCode { #define INST_LIST_INDEX_IMM 102 #define INST_LIST_RANGE_IMM 103 +#define INST_START_CMD 104 + /* The last opcode */ -#define LAST_INST_OPCODE 103 +#define LAST_INST_OPCODE 104 /* * Table describing the Tcl bytecode instructions: their name (for diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 2a313d2..3ff411d 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.121 2004/01/18 16:19:05 dkf Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.122 2004/03/30 16:22:21 msofer Exp $ */ #include "tclInt.h" @@ -61,15 +61,6 @@ int errno; # endif /* MAXDOUBLE */ #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 @@ -1098,9 +1089,11 @@ TclExecuteByteCode(interp, codePtr) int traceInstructions = (tclTraceExec == 3); char cmdNameBuf[21]; #endif - int instructionCount = 0; /* Counter that is used to work out - * when to call Tcl_AsyncReady() */ - + Namespace *namespacePtr; + int codeCompileEpoch = codePtr->compileEpoch; + int codeNsEpoch = codePtr->nsEpoch; + int codePrecompiled = (codePtr->flags & TCL_BYTECODE_PRECOMPILED); + /* * The execution uses a unified stack: first the catch stack, immediately * above it the execution stack. @@ -1134,6 +1127,11 @@ TclExecuteByteCode(interp, codePtr) iPtr->stats.numExecutions++; #endif + if (iPtr->varFramePtr != NULL) { + namespacePtr = iPtr->varFramePtr->nsPtr; + } else { + namespacePtr = iPtr->globalNsPtr; + } /* * Loop executing instructions until a "done" instruction, a @@ -1215,21 +1213,43 @@ TclExecuteByteCode(interp, codePtr) iPtr->stats.instructionCount[*pc]++; #endif - /* - * Check for asynchronous handlers [Bug 746722]; we - * do the check every 16th instruction. - */ + switch (*pc) { + case INST_START_CMD: + /* + * Check for asynchronous handlers [Bug 746722]. + */ - 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; + if (Tcl_AsyncReady()) { + DECACHE_STACK_INFO(); + result = Tcl_AsyncInvoke(interp, result); + CACHE_STACK_INFO(); + if (result == TCL_ERROR) { + goto checkForCatch; + } } - } - - switch (*pc) { + + if ((!(iPtr->flags & DELETED) + && (codeCompileEpoch == iPtr->compileEpoch) + && (codeNsEpoch == namespacePtr->resolverEpoch)) + || codePrecompiled) { + NEXT_INST_F(5, 0, 0); + } else { + bytes = GetSrcInfoForPc(pc, codePtr, &length); + result = Tcl_EvalEx(interp, bytes, length, 0); + if (result != TCL_OK) { + goto checkForCatch; + } + opnd = TclGetUInt4AtPtr(pc+1); + objResultPtr = Tcl_GetObjResult(interp); + { + Tcl_Obj *newObjResultPtr; + TclNewObj(newObjResultPtr); + Tcl_IncrRefCount(newObjResultPtr); + iPtr->objResultPtr = newObjResultPtr; + } + NEXT_INST_V(opnd, 0, -1); + } + case INST_RETURN: { int code = TclGetInt4AtPtr(pc+1); @@ -1532,14 +1552,6 @@ TclExecuteByteCode(interp, codePtr) ++*preservedStackRefCountPtr; /* - * Reset the instructionCount variable, since we're about - * to check for async stuff anyway while processing - * TclEvalObjvInternal. - */ - - instructionCount = 1; - - /* * Finally, let TclEvalObjvInternal handle the command. */ |