From c1e47417bf2cab1cb467c456f990114f78ad1680 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Tue, 11 Jun 2002 15:42:19 +0000 Subject: optimised read access to local variables created at run-time --- ChangeLog | 14 ++++++ generic/tclBasic.c | 8 +-- generic/tclCompCmds.c | 133 +++----------------------------------------------- generic/tclCompile.c | 4 +- generic/tclInt.h | 8 +-- 5 files changed, 28 insertions(+), 139 deletions(-) diff --git a/ChangeLog b/ChangeLog index ca8212a..e73429c 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,5 +1,19 @@ 2002-06-11 Miguel Sofer + * generic/tclBasic.c: + * generic/tclCompCmds.c: + * generic/tclInt.h: reverted the new compilation functions; + replaced by a more general approach described below. + + * generic/tclCompCmds.c: + * generic/tclCompile.c: made *all* compiled variable access + attempts create an indexed variable - even get or incr without + previous set. This allows indexed access to local variables that + are created and set at runtime, for example by [global], [upvar], + [variable], [regexp], [regsub]. + +2002-06-11 Miguel Sofer + * doc/global.n: * doc/info.n: * test/info.test: diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 7be14aa..22a8379 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.57 2002/06/11 13:22:35 msofer Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.58 2002/06/11 15:42:19 msofer Exp $ */ #include "tclInt.h" @@ -109,7 +109,7 @@ static CmdInfo builtInCmds[] = { {"format", (Tcl_CmdProc *) NULL, Tcl_FormatObjCmd, (CompileProc *) NULL, 1}, {"global", (Tcl_CmdProc *) NULL, Tcl_GlobalObjCmd, - TclCompileGlobalCmd, 1}, + (CompileProc *) NULL, 1}, {"if", (Tcl_CmdProc *) NULL, Tcl_IfObjCmd, TclCompileIfCmd, 1}, {"incr", (Tcl_CmdProc *) NULL, Tcl_IncrObjCmd, @@ -173,9 +173,9 @@ static CmdInfo builtInCmds[] = { {"uplevel", (Tcl_CmdProc *) NULL, Tcl_UplevelObjCmd, (CompileProc *) NULL, 1}, {"upvar", (Tcl_CmdProc *) NULL, Tcl_UpvarObjCmd, - TclCompileUpvarCmd, 1}, + (CompileProc *) NULL, 1}, {"variable", (Tcl_CmdProc *) NULL, Tcl_VariableObjCmd, - TclCompileVariableCmd, 1}, + (CompileProc *) NULL, 1}, {"while", (Tcl_CmdProc *) NULL, Tcl_WhileObjCmd, TclCompileWhileCmd, 1}, diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index a9b04a2..3b04946 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.29 2002/06/11 13:22:36 msofer Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.30 2002/06/11 15:42:20 msofer Exp $ */ #include "tclInt.h" @@ -1117,59 +1117,6 @@ FreeForeachInfo(clientData) /* *---------------------------------------------------------------------- * - * TclCompileGlobalCmd -- - * - * Procedure called to reserve the local variables for the - * "global" command. The command itself is *not* compiled. - * - * Results: - * Always returns TCL_OUT_LINE_COMPILE. - * - * Side effects: - * Indexed local variables are added to the environment. - * - *---------------------------------------------------------------------- - */ -int -TclCompileGlobalCmd(interp, parsePtr, envPtr) - Tcl_Interp *interp; /* Used for error reporting. */ - Tcl_Parse *parsePtr; /* Points to a parse structure for the - * command created by Tcl_ParseCommand. */ - CompileEnv *envPtr; /* Holds resulting instructions. */ -{ - Tcl_Token *varTokenPtr; - int i, numWords; - char *varName, *tail; - - if (envPtr->procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; - } - numWords = parsePtr->numWords; - - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); - for (i = 1; i < numWords; i++) { - if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - varName = varTokenPtr[1].start; - tail = varName + varTokenPtr[1].size - 1; - if ((*tail == ')') || (tail < varName)) continue; - while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) { - tail--; - } - if ((*tail == ':') && (tail > varName)) { - tail++; - } - (void) TclFindCompiledLocal(tail, (tail-varName+1), - /*create*/ 1, /*flags*/ 0, envPtr->procPtr); - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); - } - } - return TCL_OUT_LINE_COMPILE; -} - -/* - *---------------------------------------------------------------------- - * * TclCompileIfCmd -- * * Procedure called to compile the "if" command. @@ -1587,7 +1534,8 @@ TclCompileIncrCmd(interp, parsePtr, envPtr) varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); - code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX, + code = TclPushVarName(interp, varTokenPtr, envPtr, + (TCL_NO_LARGE_INDEX | TCL_CREATE_VAR), &localIndex, &simpleVarName, &isScalar); if (code != TCL_OK) { goto done; @@ -2125,8 +2073,8 @@ TclCompileLsetCmd( interp, parsePtr, envPtr ) varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); - result = TclPushVarName( interp, varTokenPtr, envPtr, 0, - &localIndex, &simpleVarName, &isScalar ); + result = TclPushVarName( interp, varTokenPtr, envPtr, + TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar ); if (result != TCL_OK) { return result; } @@ -2576,8 +2524,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr) varTokenPtr = parsePtr->tokenPtr + (parsePtr->tokenPtr->numComponents + 1); - code = TclPushVarName(interp, varTokenPtr, envPtr, - (isAssignment ? TCL_CREATE_VAR : 0), + code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar); if (code != TCL_OK) { goto done; @@ -2898,72 +2845,6 @@ TclCompileStringCmd(interp, parsePtr, envPtr) /* *---------------------------------------------------------------------- * - * TclCompileUpvarCmd -- - * - * Procedure called to reserve the local variables for the - * "upvar" command. The command itself is *not* compiled. - * - * Results: - * Always returns TCL_OUT_LINE_COMPILE. - * - * Side effects: - * Indexed local variables are added to the environment. - * - *---------------------------------------------------------------------- - */ -int -TclCompileUpvarCmd(interp, parsePtr, envPtr) - Tcl_Interp *interp; /* Used for error reporting. */ - Tcl_Parse *parsePtr; /* Points to a parse structure for the - * command created by Tcl_ParseCommand. */ - CompileEnv *envPtr; /* Holds resulting instructions. */ -{ - Tcl_Token *varTokenPtr; - int i, numWords; - char *varName, *tail; - - if (envPtr->procPtr == NULL) { - return TCL_OUT_LINE_COMPILE; - } - - numWords = parsePtr->numWords; - - varTokenPtr = parsePtr->tokenPtr - + (parsePtr->tokenPtr->numComponents + 1); - varName = varTokenPtr[1].start; - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); - i = 2; - - if ((*varName == '#') || (isdigit(UCHAR(*varName)))) { - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); - i++; - } - - for (; i < numWords; i += 2) { - if (varTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { - varName = varTokenPtr[1].start; - tail = varName + varTokenPtr[1].size - 1; - if ((*tail == ')') || (tail < varName)) { - break; - } - while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) { - tail--; - } - if (tail != varName) { - break; - } - (void) TclFindCompiledLocal(tail, (tail-varName+1), - /*create*/ 1, /*flags*/ 0, envPtr->procPtr); - varTokenPtr = varTokenPtr + (varTokenPtr->numComponents + 1); - } - } - return TCL_OUT_LINE_COMPILE; -} - - -/* - *---------------------------------------------------------------------- - * * TclCompileVariableCmd -- * * Procedure called to reserve the local variables for the @@ -3262,7 +3143,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr, Tcl_Token *varTokenPtr; /* Points to a variable token. */ CompileEnv *envPtr; /* Holds resulting instructions. */ int flags; /* takes TCL_CREATE_VAR or - * TCL_LARGE_INDEX_OK */ + * TCL_NO_LARGE_INDEX */ int *localIndexPtr; /* must not be NULL */ int *simpleVarNamePtr; /* must not be NULL */ int *isScalarPtr; /* must not be NULL */ diff --git a/generic/tclCompile.c b/generic/tclCompile.c index bd94b86..3c3a7ff 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.33 2002/05/30 15:03:57 msofer Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.34 2002/06/11 15:42:20 msofer Exp $ */ #include "tclInt.h" @@ -1212,7 +1212,7 @@ TclCompileTokens(interp, tokenPtr, count, envPtr) /*onHeap*/ 0), envPtr); } else { localVar = TclFindCompiledLocal(name, nameBytes, - /*create*/ 0, /*flags*/ 0, envPtr->procPtr); + /*create*/ 1, /*flags*/ 0, envPtr->procPtr); if (localVar < 0) { TclEmitPush(TclRegisterLiteral(envPtr, name, nameBytes, /*onHeap*/ 0), envPtr); diff --git a/generic/tclInt.h b/generic/tclInt.h index a6d5259..60ea8e1 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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: tclInt.h,v 1.92 2002/06/11 13:22:36 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.93 2002/06/11 15:42:21 msofer Exp $ */ #ifndef _TCLINT @@ -2127,8 +2127,6 @@ EXTERN int TclCompileForCmd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); EXTERN int TclCompileForeachCmd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); -EXTERN int TclCompileGlobalCmd _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); EXTERN int TclCompileIfCmd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); EXTERN int TclCompileIncrCmd _ANSI_ARGS_((Tcl_Interp *interp, @@ -2151,10 +2149,6 @@ EXTERN int TclCompileSetCmd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); EXTERN int TclCompileStringCmd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); -EXTERN int TclCompileUpvarCmd _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); -EXTERN int TclCompileVariableCmd _ANSI_ARGS_((Tcl_Interp *interp, - Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); EXTERN int TclCompileWhileCmd _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Parse *parsePtr, struct CompileEnv *envPtr)); -- cgit v0.12