summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2002-06-11 15:42:19 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2002-06-11 15:42:19 (GMT)
commitc1e47417bf2cab1cb467c456f990114f78ad1680 (patch)
treea14fcf1723483c4f75d4dcf3eba0ca9c3c19e9e5 /generic
parent564998e2aa2fb9a4c640a8ed265668c87696fa39 (diff)
downloadtcl-c1e47417bf2cab1cb467c456f990114f78ad1680.zip
tcl-c1e47417bf2cab1cb467c456f990114f78ad1680.tar.gz
tcl-c1e47417bf2cab1cb467c456f990114f78ad1680.tar.bz2
optimised read access to local variables created at run-time
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c8
-rw-r--r--generic/tclCompCmds.c133
-rw-r--r--generic/tclCompile.c4
-rw-r--r--generic/tclInt.h8
4 files changed, 14 insertions, 139 deletions
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));