summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2004-05-12 17:43:52 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2004-05-12 17:43:52 (GMT)
commit200415876026090ba976a55f11c319630f0ef9ae (patch)
treea05f9e6a5498d422911ad35005a0f3a51b875ceb
parent0d8310f9be1577fb211b01fbbe020ea6621fc1e5 (diff)
downloadtcl-200415876026090ba976a55f11c319630f0ef9ae.zip
tcl-200415876026090ba976a55f11c319630f0ef9ae.tar.gz
tcl-200415876026090ba976a55f11c319630f0ef9ae.tar.bz2
Optimisations for INST_START_CMD [Bug 926164].
* generic/tclCompile.c (TclCompileScript): avoid emitting INST_START_CMD as the first instruction in a bytecoded Tcl_Obj. It is not needed, as the checks are done before calling TEBC. * generic/tclExecute.c (TclExecuteByteCode): runtime peephole optimisation: check at INST_POP if the next instruction is INST_START_CMD, in which case we fall through.
-rw-r--r--ChangeLog10
-rw-r--r--generic/tclCompile.c34
-rw-r--r--generic/tclExecute.c59
3 files changed, 65 insertions, 38 deletions
diff --git a/ChangeLog b/ChangeLog
index ff9b232..ac64483 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2004-05-12 Miguel Sofer <msofer@users.sf.net>
+
+ Optimisations for INST_START_CMD [Bug 926164].
+ * generic/tclCompile.c (TclCompileScript): avoid emitting
+ INST_START_CMD as the first instruction in a bytecoded Tcl_Obj. It
+ is not needed, as the checks are done before calling TEBC.
+ * generic/tclExecute.c (TclExecuteByteCode): runtime peephole
+ optimisation: check at INST_POP if the next instruction is
+ INST_START_CMD, in which case we fall through.
+
2004-05-11 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* doc/split.n, doc/join.n: Updated examples and added more.
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index e75a5a4..c918c5d 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.64 2004/05/04 02:44:23 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.65 2004/05/12 17:43:54 msofer Exp $
*/
#include "tclInt.h"
@@ -1057,28 +1057,36 @@ TclCompileScript(interp, script, numBytes, envPtr)
&& !(iPtr->flags & DONT_COMPILE_CMDS_INLINE)) {
int savedNumCmds = envPtr->numCommands;
unsigned int savedCodeNext =
- envPtr->codeNext - envPtr->codeStart;
+ envPtr->codeNext - envPtr->codeStart;
/*
* Mark the start of the command; the proper
- * bytecode length will be updated later.
+ * bytecode length will be updated later. There
+ * is no need to do this for the first command
+ * in the compile env, as the check is done before
+ * calling TclExecuteByteCode(). Remark that we
+ * are compiling the first cmd in the environment
+ * exactly when (savedCodeNext == 0)
*/
-
- TclEmitInstInt4(INST_START_CMD, 0, envPtr);
+
+ if (savedCodeNext != 0) {
+ 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);
+ if (savedCodeNext != 0) {
+ /*
+ * 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/tclExecute.c b/generic/tclExecute.c
index daa560c..6182a51 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.124 2004/04/06 22:25:50 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.125 2004/05/12 17:43:55 msofer Exp $
*/
#include "tclInt.h"
@@ -1239,29 +1239,6 @@ TclExecuteByteCode(interp, codePtr)
}
switch (*pc) {
- case INST_START_CMD:
- 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);
@@ -1319,7 +1296,39 @@ TclExecuteByteCode(interp, codePtr)
TRACE_WITH_OBJ(("=> discarding "), *tosPtr);
valuePtr = POP_OBJECT();
TclDecrRefCount(valuePtr);
- NEXT_INST_F(1, 0, 0);
+
+ /*
+ * Runtime peephole optimisation: an INST_POP is scheduled
+ * at the end of most commands. If the next instruction is an
+ * INST_START_CMD, fall through to it.
+ */
+ pc++;
+ if (*pc != INST_START_CMD) {
+ NEXT_INST_F(0, 0, 0);
+ }
+
+ case INST_START_CMD:
+ 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_DUP:
objResultPtr = *tosPtr;