From 200415876026090ba976a55f11c319630f0ef9ae Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Wed, 12 May 2004 17:43:52 +0000 Subject: 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. --- ChangeLog | 10 +++++++++ generic/tclCompile.c | 34 ++++++++++++++++++------------ generic/tclExecute.c | 59 ++++++++++++++++++++++++++++++---------------------- 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 + + 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 * 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; -- cgit v0.12