optimised read access to local variables created at run-time

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  <msofer@users.sourceforge.net>
 
+	* 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  <msofer@users.sourceforge.net>
+
 	* 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));