From 57ba79b9aa406ba55b5987ac6bf3556cce00d9df Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Sun, 10 Jun 2007 23:15:05 +0000 Subject: * generic/tclBasic.c: Further TEOvI split, creating a new * generic/tclCompile.h: TclEvalObjvKnownCommand() function to * generic/tclExecute.c: handle commands that are already known and are not traced. INST_INVOKE now calls into this function instead of inlining parts of TEOvI. Same perf, better isolation. --- ChangeLog | 10 +++- generic/tclBasic.c | 136 ++++++++++++++++++++++++++++----------------------- generic/tclCompile.h | 8 +-- generic/tclExecute.c | 17 ++----- 4 files changed, 93 insertions(+), 78 deletions(-) diff --git a/ChangeLog b/ChangeLog index 2371e9f..3f4c78a 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2007-06-10 Miguel Sofer + + * generic/tclBasic.c: Further TEOvI split, creating a new + * generic/tclCompile.h: TclEvalObjvKnownCommand() function to + * generic/tclExecute.c: handle commands that are already known + and are not traced. INST_INVOKE now calls into this function + instead of inlining parts of TEOvI. Same perf, better isolation. + 2007-06-10 Jeff Hobbs * README: updated links. [Bug 1715081] @@ -25,7 +33,7 @@ logic clearer; slightly faster too. * generic/tclBasic.c: Split TEOv in two, by separating a - processor for non-TCL_OK returns. Also spli TEOvI in a full + processor for non-TCL_OK returns. Also split TEOvI in a full version that handles non-existing and traced commands, and a separate shorter version for the regular case. diff --git a/generic/tclBasic.c b/generic/tclBasic.c index a06b203..8be21cc 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclBasic.c,v 1.248 2007/06/10 21:14:41 hobbs Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.249 2007/06/10 23:15:05 msofer Exp $ */ #include "tclInt.h" @@ -3383,12 +3383,21 @@ TclInterpReady( /* *---------------------------------------------------------------------- * - * TclEvalObjvInternal -- + * TclEvalObjvInternal, FullEvalObjvInternal, TclEvalObjvKnownCommand -- * - * This function evaluates a Tcl command that has already been parsed + * These functions evaluate a Tcl command that has already been parsed * into words, with one Tcl_Obj holding each word. The caller is * responsible for managing the iPtr->numLevels. * + * TclEvalObjvInternal is the backend for Tcl_EvalObjv, the other two are + * separate backends for TclEvalObjvInternal: + * - FullEvalObjvInternal is the full implementation, with [unknown] and + * trace handling. + * - TclEvalObjvKnownCommand is a fast implementation for known untraced + * commands. + * The bytecode engine calls directly into both TclEvalObjvInternal and + * TclEvalObjvKnownCommand. + * * Results: * The return value is a standard Tcl completion code such as TCL_OK or * TCL_ERROR. A result or error message is left in interp's result. If an @@ -3681,6 +3690,56 @@ FullEvalObjvInternal( } int +TclEvalObjvKnownCommand( + Tcl_Interp *interp, /* Interpreter in which to evaluate the + * command. Also used for error reporting. */ + int objc, /* Number of words in command. */ + Tcl_Obj *const objv[], /* An array of pointers to objects that are + * the words that make up the command. */ + Command *cmdPtr) /* The already determined valid command */ +{ + Interp *iPtr = (Interp *) interp; + int code = TCL_OK; + + /* + * Finally, invoke the command's Tcl_ObjCmdProc. + */ + + cmdPtr->refCount++; + iPtr->cmdCount++; + + if (!TclLimitExceeded(iPtr->limit)) { + code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); + } + if (Tcl_AsyncReady()) { + code = Tcl_AsyncInvoke(interp, code); + } + if (code == TCL_OK && TclLimitReady(iPtr->limit)) { + code = Tcl_LimitCheck(interp); + } + + /* + * Decrement the reference count of cmdPtr and deallocate it if it has + * dropped to zero. + */ + + TclCleanupCommandMacro(cmdPtr); + + /* + * If the interpreter has a non-empty string result, the result object is + * either empty or stale because some function set interp->result + * directly. If so, move the string result to the result object, then + * reset the string result. + */ + + if (*(iPtr->result) != 0) { + (void) Tcl_GetObjResult(interp); + } + + return code; +} + +int TclEvalObjvInternal( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ @@ -3702,9 +3761,7 @@ TclEvalObjvInternal( { Command *cmdPtr; Interp *iPtr = (Interp *) interp; - CallFrame *savedVarFramePtr = NULL; CallFrame *varFramePtr = iPtr->varFramePtr; - int code = TCL_OK; Namespace *savedNsPtr = NULL; Namespace *lookupNsPtr = iPtr->lookupNsPtr; @@ -3729,11 +3786,12 @@ TclEvalObjvInternal( } else { varFramePtr->nsPtr = iPtr->globalNsPtr; } - } else if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr) - && !savedVarFramePtr) { - varFramePtr = iPtr->rootFramePtr; - savedVarFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = varFramePtr; + } else if ((flags & TCL_EVAL_GLOBAL) && (varFramePtr != iPtr->rootFramePtr)) { + /* + * Use the full version, so that this one can do optimised tail calls. + */ + + return FullEvalObjvInternal(interp, objc, objv, command, length, flags); } } @@ -3746,65 +3804,23 @@ TclEvalObjvInternal( if (savedNsPtr) { varFramePtr->nsPtr = savedNsPtr; } - - if ((cmdPtr == NULL) || (iPtr->tracePtr != NULL) || - (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { + + if ((cmdPtr && !iPtr->tracePtr && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES))) { + if (!(flags & TCL_EVAL_INVOKE) && + (iPtr->ensembleRewrite.sourceObjs != NULL)) { + iPtr->ensembleRewrite.sourceObjs = NULL; + } + return TclEvalObjvKnownCommand(interp, objc, objv, cmdPtr); + } else { /* * Need the full version: command is either unknown or traced */ - if (savedVarFramePtr) { - iPtr->varFramePtr = savedVarFramePtr; - } if (lookupNsPtr) { iPtr->lookupNsPtr = lookupNsPtr; } return FullEvalObjvInternal(interp, objc, objv, command, length, flags); } - - /* - * Finally, invoke the command's Tcl_ObjCmdProc. - */ - - cmdPtr->refCount++; - iPtr->cmdCount++; - - if (!TclLimitExceeded(iPtr->limit)) { - if (!(flags & TCL_EVAL_INVOKE) && - (iPtr->ensembleRewrite.sourceObjs != NULL)) { - iPtr->ensembleRewrite.sourceObjs = NULL; - } - code = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv); - } - if (Tcl_AsyncReady()) { - code = Tcl_AsyncInvoke(interp, code); - } - if (code == TCL_OK && TclLimitReady(iPtr->limit)) { - code = Tcl_LimitCheck(interp); - } - - /* - * Decrement the reference count of cmdPtr and deallocate it if it has - * dropped to zero. - */ - - TclCleanupCommandMacro(cmdPtr); - - /* - * If the interpreter has a non-empty string result, the result object is - * either empty or stale because some function set interp->result - * directly. If so, move the string result to the result object, then - * reset the string result. - */ - - if (*(iPtr->result) != 0) { - (void) Tcl_GetObjResult(interp); - } - - if (savedVarFramePtr) { - iPtr->varFramePtr = savedVarFramePtr; - } - return code; } /* diff --git a/generic/tclCompile.h b/generic/tclCompile.h index f27843e..d96c5f1 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.71 2007/05/30 18:12:58 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.72 2007/06/10 23:15:05 msofer Exp $ */ #ifndef _TCLCOMPILATION @@ -806,9 +806,11 @@ typedef struct { */ MODULE_SCOPE int TclEvalObjvInternal(Tcl_Interp *interp, - int objc, Tcl_Obj *CONST objv[], + int objc, Tcl_Obj *const objv[], CONST char *command, int length, int flags); - +MODULE_SCOPE int TclEvalObjvKnownCommand(Tcl_Interp *interp, + int objc, Tcl_Obj *const objv[], + Command *cmdPtr); /* *---------------------------------------------------------------- * Procedures exported by the engine to be used by tclBasic.c diff --git a/generic/tclExecute.c b/generic/tclExecute.c index ea416f9..12f85bc 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -12,7 +12,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.289 2007/06/10 20:39:40 hobbs Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.290 2007/06/10 23:15:06 msofer Exp $ */ #include "tclInt.h" @@ -1969,21 +1969,10 @@ TclExecuteByteCode( && (!checkInterp || (codePtr->compileEpoch == iPtr->compileEpoch))) { /* - * No traces, the interp is ok: avoid the call out to TEOVi + * No traces, the interp is ok: use the fast interface */ - cmdPtr->refCount++; - iPtr->cmdCount++; - iPtr->ensembleRewrite.sourceObjs = NULL; - result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, - objc, objv); - TclCleanupCommandMacro(cmdPtr); - if (Tcl_AsyncReady()) { - result = Tcl_AsyncInvoke(interp, result); - } - if (result == TCL_OK && TclLimitReady(iPtr->limit)) { - result = Tcl_LimitCheck(interp); - } + result = TclEvalObjvKnownCommand(interp, objc, objv, cmdPtr); } else { /* * If trace procedures will be called, we need a command -- cgit v0.12