diff options
Diffstat (limited to 'generic/tclCompCmds.c')
| -rw-r--r-- | generic/tclCompCmds.c | 175 |
1 files changed, 174 insertions, 1 deletions
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index fefc33a..a9b04a2 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.28 2002/05/29 09:09:12 hobbs Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.29 2002/06/11 13:22:36 msofer Exp $ */ #include "tclInt.h" @@ -1117,6 +1117,59 @@ 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. @@ -2845,6 +2898,126 @@ 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 + * "variable" 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 +TclCompileVariableCmd(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 += 2) { + 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; +} + +/* + *---------------------------------------------------------------------- + * * TclCompileWhileCmd -- * * Procedure called to compile the "while" command. |