From c03361743edafd9fb6efa93d447864aebeb0f8d2 Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 25 Jan 2008 16:43:50 +0000 Subject: merge updates from HEAD --- ChangeLog | 21 ++++++++++++ generic/tclBasic.c | 9 +++-- generic/tclCompCmds.c | 35 +++++++++---------- generic/tclCompExpr.c | 24 ++++--------- generic/tclCompile.c | 5 +-- generic/tclCompile.h | 9 ++--- generic/tclExecute.c | 15 ++++---- generic/tclIOUtil.c | 18 +++++----- generic/tclInt.decls | 11 +++--- generic/tclInt.h | 49 +++++++++++++++++++++++++-- generic/tclIntDecls.h | 17 +++------- generic/tclParse.c | 94 ++++++++++++--------------------------------------- generic/tclStubInit.c | 4 +-- 13 files changed, 151 insertions(+), 160 deletions(-) diff --git a/ChangeLog b/ChangeLog index b289a06..30271f5 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,24 @@ +2008-01-23 Don Porter + + * generic/tclInt.h: New macro TclGrowParseTokenArray() to + * generic/tclCompCmds.c: simplify code that might need to grow + * generic/tclCompExpr.c: an array of Tcl_Tokens in the parsePtr + * generic/tclParse.c: field of a Tcl_Parse. Replaces the + TclExpandTokenArray() routine via replacing: + int needed = parsePtr->numTokens + growth; + while (needed > parsePtr->tokensAvailable) { + TclExpandTokenArray(parsePtr); + } + with: + TclGrowParseTokenArray(parsePtr, growth); + This revision merged over from dgp-refactor branch. + + * generic/tclCompile.h: Demote TclCompEvalObj() from internal stubs to + * generic/tclInt.decls: a MODULE_SCOPE routine declared in tclCompile.h. + + * generic/tclIntDecls.h: make genstubs + * generic/tclStubInit.c: + 2008-01-22 Don Porter * generic/tclTimer.c (AfterProc): Replace Tcl_EvalEx() with diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 30ca044..73c1c12 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -14,7 +14,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.244.2.21 2008/01/23 16:42:17 dgp Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.244.2.22 2008/01/25 16:43:50 dgp Exp $ */ #include "tclInt.h" @@ -3588,7 +3588,7 @@ TclEvalObjvInternal( */ cmdPtr->refCount++; - if (iPtr->tracePtr && (traceCode == TCL_OK)) { + if (iPtr->tracePtr && (traceCode == TCL_OK)) { traceCode = TclCheckInterpTraces(interp, command, length, cmdPtr, code, TCL_TRACE_ENTER_EXEC, objc, objv); } @@ -4097,7 +4097,7 @@ TclEvalEx( Tcl_Obj *norm = Tcl_FSGetNormalizedPath(interp, iPtr->scriptFile); - if (!norm) { + if (norm == NULL) { /* * Error message in the interp result. */ @@ -4118,8 +4118,7 @@ TclEvalEx( eeFramePtr->data.eval.path = NULL; } - eeFramePtr->level = - (iPtr->cmdFramePtr==NULL ? 1 : iPtr->cmdFramePtr->level+1); + eeFramePtr->level = iPtr->cmdFramePtr ? iPtr->cmdFramePtr->level + 1 : 1; eeFramePtr->framePtr = iPtr->framePtr; eeFramePtr->nextPtr = iPtr->cmdFramePtr; eeFramePtr->nline = 0; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index d66f672..c56aee6 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.109.2.18 2008/01/23 16:42:18 dgp Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.19 2008/01/25 16:43:51 dgp Exp $ */ #include "tclInt.h" @@ -6141,7 +6141,7 @@ TclCompileEnsemble( * compiled. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Tcl_Token *tokenPtr, *argTokensPtr; + Tcl_Token *tokenPtr; Tcl_Obj *mapObj, *subcmdObj, *targetCmdObj, *listObj, **elems; Tcl_Command ensemble = (Tcl_Command) cmdPtr; Tcl_Parse synthetic; @@ -6339,18 +6339,10 @@ TclCompileEnsemble( * do that, we have to perform some trickery to rewrite the arguments. */ - argTokensPtr = TokenAfter(tokenPtr); - memcpy(&synthetic, parsePtr, sizeof(Tcl_Parse)); - synthetic.numWords -= 2 - len; - synthetic.numTokens -= (argTokensPtr - parsePtr->tokenPtr) - 2*len; - if (synthetic.numTokens <= NUM_STATIC_TOKENS) { - synthetic.tokenPtr = synthetic.staticTokens; - synthetic.tokensAvailable = NUM_STATIC_TOKENS; - } else { - synthetic.tokenPtr = - TclStackAlloc(interp, sizeof(Tcl_Token) * synthetic.numTokens); - synthetic.tokensAvailable = synthetic.numTokens; - } + TclParseInit(interp, NULL, 0, &synthetic); + synthetic.numWords = parsePtr->numWords - 2 + len; + TclGrowParseTokenArray(&synthetic, 2*len); + synthetic.numTokens = 2*len; /* * Now we have the space to work in, install something rewritten. Note @@ -6378,8 +6370,15 @@ TclCompileEnsemble( * Copy over the real argument tokens. */ - memcpy(synthetic.tokenPtr + 2*len, argTokensPtr, - sizeof(Tcl_Token) * (synthetic.numTokens - 2*len)); + for (i=len; inumComponents + 1; + TclGrowParseTokenArray(&synthetic, toCopy); + memcpy(synthetic.tokenPtr + synthetic.numTokens, tokenPtr, + sizeof(Tcl_Token) * toCopy); + synthetic.numTokens += toCopy; + } /* * Hand off compilation to the subcommand compiler. At last! @@ -6391,9 +6390,7 @@ TclCompileEnsemble( * Clean up if necessary. */ - if (synthetic.tokenPtr != synthetic.staticTokens) { - TclStackFree(interp, synthetic.tokenPtr); - } + Tcl_FreeParse(&synthetic); return result; } diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 13075d7..e095f6d 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -10,7 +10,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompExpr.c,v 1.53.2.13 2008/01/23 16:42:18 dgp Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.53.2.14 2008/01/25 16:43:51 dgp Exp $ */ #include "tclInt.h" @@ -865,9 +865,7 @@ ParseExpr( * make room for at least 2 more tokens. */ - if (parsePtr->numTokens+1 >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 2); wordIndex = parsePtr->numTokens; tokenPtr = parsePtr->tokenPtr + wordIndex; tokenPtr->type = TCL_TOKEN_WORD; @@ -1466,9 +1464,7 @@ ConvertTreeToTokens( /* Reparse the literal to get pointers into source string */ scanned = ParseLexeme(start, numBytes, &lexeme, NULL); - if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 2); subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; subExprTokenPtr->start = start; @@ -1509,10 +1505,7 @@ ConvertTreeToTokens( * token to TCL_TOKEN_SUB_EXPR. */ - while (parsePtr->numTokens + toCopy - 1 - >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, toCopy); subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; memcpy(subExprTokenPtr, tokenPtr, (size_t) toCopy * sizeof(Tcl_Token)); @@ -1526,10 +1519,7 @@ ConvertTreeToTokens( * token, then copy entire set of word tokens. */ - while (parsePtr->numTokens + toCopy - >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, toCopy+1); subExprTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; *subExprTokenPtr = *tokenPtr; subExprTokenPtr->type = TCL_TOKEN_SUB_EXPR; @@ -1586,9 +1576,7 @@ ConvertTreeToTokens( * of type TCL_TOKEN_OPERATOR. */ - if (parsePtr->numTokens + 1 >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 2); subExprTokenIdx = parsePtr->numTokens; subExprTokenPtr = parsePtr->tokenPtr + subExprTokenIdx; parsePtr->numTokens += 2; diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 9a97dfb..fbc0459 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.117.2.16 2008/01/23 16:42:18 dgp Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.117.2.17 2008/01/25 16:43:52 dgp Exp $ */ #include "tclInt.h" @@ -1694,7 +1694,8 @@ TclCompileTokens( break; default: - Tcl_Panic("Unexpected token type in TclCompileTokens"); + Tcl_Panic("Unexpected token type in TclCompileTokens: %d; %.*s", + tokenPtr->type, tokenPtr->size, tokenPtr->start); } } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 44367c9..9342da9 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -9,7 +9,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.70.2.13 2008/01/23 16:42:18 dgp Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.70.2.14 2008/01/25 16:43:52 dgp Exp $ */ #ifndef _TCLCOMPILATION @@ -840,11 +840,8 @@ MODULE_SCOPE int TclEvalObjvInternal(Tcl_Interp *interp, *---------------------------------------------------------------- */ -/* - * Declaration moved to the internal stubs table - * -MODULE_SCOPE int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr); - */ +MODULE_SCOPE int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, + const CmdFrame *invoker, int word); /* *---------------------------------------------------------------- diff --git a/generic/tclExecute.c b/generic/tclExecute.c index a2d1310..1a9b996 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.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: tclExecute.c,v 1.285.2.28 2008/01/23 16:42:18 dgp Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.285.2.29 2008/01/25 16:43:52 dgp Exp $ */ #include "tclInt.h" @@ -1339,8 +1339,8 @@ TclCompEvalObj( iPtr->numLevels++; if (TclInterpReady(interp) == TCL_ERROR) { - iPtr->numLevels--; - return TCL_ERROR; + result = TCL_ERROR; + goto done; } namespacePtr = iPtr->varFramePtr->nsPtr; @@ -1404,8 +1404,7 @@ TclCompEvalObj( if (codePtr->refCount <= 0) { TclCleanupByteCode(codePtr); } - iPtr->numLevels--; - return result; + goto done; } recompileObj: @@ -1424,6 +1423,10 @@ TclCompEvalObj( iPtr->invokeCmdFramePtr = NULL; codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr; goto runCompiledObj; + + done: + iPtr->numLevels--; + return result; } /* @@ -2404,7 +2407,7 @@ TclExecuteByteCode( * context. */ - result = TclCompEvalObj(interp, objPtr, NULL,0); + result = TclCompEvalObj(interp, objPtr, NULL, 0); CACHE_STACK_INFO(); if (result == TCL_OK) { /* diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 43be6fb..a278a1d 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -17,7 +17,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclIOUtil.c,v 1.145.2.3 2008/01/23 16:42:19 dgp Exp $ + * RCS: @(#) $Id: tclIOUtil.c,v 1.145.2.4 2008/01/25 16:43:53 dgp Exp $ */ #include "tclInt.h" @@ -1755,7 +1755,7 @@ Tcl_FSEvalFileEx( const char *encodingName) /* If non-NULL, then use this encoding for the * file. NULL means use the system encoding. */ { - int result, length; + int length, result = TCL_ERROR; Tcl_StatBuf statBuf; Tcl_Obj *oldScriptFile; Interp *iPtr; @@ -1764,25 +1764,21 @@ Tcl_FSEvalFileEx( Tcl_Obj *objPtr; if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { - return TCL_ERROR; + return result; } - result = TCL_ERROR; - objPtr = Tcl_NewObj(); - Tcl_IncrRefCount(objPtr); - if (Tcl_FSStat(pathPtr, &statBuf) == -1) { Tcl_SetErrno(errno); Tcl_AppendResult(interp, "couldn't read file \"", Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL); - goto end; + return result; } chan = Tcl_FSOpenFileChannel(interp, pathPtr, "r", 0644); if (chan == (Tcl_Channel) NULL) { Tcl_ResetResult(interp); Tcl_AppendResult(interp, "couldn't read file \"", Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL); - goto end; + return result; } /* @@ -1801,10 +1797,12 @@ Tcl_FSEvalFileEx( if (Tcl_SetChannelOption(interp, chan, "-encoding", encodingName) != TCL_OK) { Tcl_Close(interp,chan); - goto end; + return result; } } + objPtr = Tcl_NewObj(); + Tcl_IncrRefCount(objPtr); if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) { Tcl_Close(interp, chan); Tcl_AppendResult(interp, "couldn't read file \"", diff --git a/generic/tclInt.decls b/generic/tclInt.decls index 608413b..34342f0 100644 --- a/generic/tclInt.decls +++ b/generic/tclInt.decls @@ -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: tclInt.decls,v 1.108.2.7 2007/12/11 16:19:55 dgp Exp $ +# RCS: @(#) $Id: tclInt.decls,v 1.108.2.8 2008/01/25 16:43:53 dgp Exp $ library tcl @@ -797,11 +797,12 @@ declare 183 generic { # # Added in tcl8.5a5 for compiler/executor experimentation. +# Disabled in Tcl 8.5.1; experiments terminated. :/ # -declare 197 generic { - int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, - CONST CmdFrame* invoker, int word) -} +#declare 197 generic { +# int TclCompEvalObj(Tcl_Interp *interp, Tcl_Obj *objPtr, +# CONST CmdFrame* invoker, int word) +#} declare 198 generic { int TclObjGetFrame(Tcl_Interp *interp, Tcl_Obj *objPtr, CallFrame **framePtrPtr) diff --git a/generic/tclInt.h b/generic/tclInt.h index 3ea4415..c3b06f1 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -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: tclInt.h,v 1.310.2.24 2008/01/23 16:42:19 dgp Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.310.2.25 2008/01/25 16:43:53 dgp Exp $ */ #ifndef _TCLINT @@ -2447,7 +2447,6 @@ MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); /* TIP #280 - Modified token based evulation, with line information */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, int numBytes, int flags, int line); -MODULE_SCOPE void TclExpandTokenArray(Tcl_Parse *parsePtr); MODULE_SCOPE int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclFileCopyCmd(Tcl_Interp *interp, @@ -3503,6 +3502,52 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr); /* *---------------------------------------------------------------- + * Macros used by the Tcl core to grow Tcl_Token arrays. They use + * the same growth algorithm as used in tclStringObj.c for growing + * strings. The ANSI C "prototype" for this macro is: + * + * MODULE_SCOPE void TclGrowTokenArray(Tcl_Token *tokenPtr, int used, + * int available, int append, + * Tcl_Token *staticPtr); + * MODULE_SCOPE void TclGrowParseTokenArray(Tcl_Parse *parsePtr, + * int append); + *---------------------------------------------------------------- + */ + +#define TCL_MIN_TOKEN_GROWTH 50 +#define TclGrowTokenArray(tokenPtr, used, available, append, staticPtr) \ +{ \ + int needed = (used) + (append); \ + if (needed > (available)) { \ + int allocated = 2 * needed; \ + Tcl_Token *oldPtr = (tokenPtr); \ + Tcl_Token *newPtr; \ + if (oldPtr == (staticPtr)) { \ + oldPtr = NULL; \ + } \ + newPtr = (Tcl_Token *) attemptckrealloc( (char *) oldPtr, \ + (unsigned int) (allocated * sizeof(Tcl_Token))); \ + if (newPtr == NULL) { \ + allocated = needed + (append) + TCL_MIN_TOKEN_GROWTH; \ + newPtr = (Tcl_Token *) ckrealloc( (char *) oldPtr, \ + (unsigned int) (allocated * sizeof(Tcl_Token))); \ + } \ + (available) = allocated; \ + if (oldPtr == NULL) { \ + memcpy((VOID *) newPtr, (VOID *) staticPtr, \ + (size_t) ((used) * sizeof(Tcl_Token))); \ + } \ + (tokenPtr) = newPtr; \ + } \ +} + +#define TclGrowParseTokenArray(parsePtr, append) \ + TclGrowTokenArray((parsePtr)->tokenPtr, (parsePtr)->numTokens, \ + (parsePtr)->tokensAvailable, (append), \ + (parsePtr)->staticTokens) + +/* + *---------------------------------------------------------------- * Macro used by the Tcl core get a unicode char from a utf string. It checks * to see if we have a one-byte utf char before calling the real * Tcl_UtfToUniChar, as this will save a lot of time for primarily ascii diff --git a/generic/tclIntDecls.h b/generic/tclIntDecls.h index e17987e..f1374d2 100644 --- a/generic/tclIntDecls.h +++ b/generic/tclIntDecls.h @@ -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: tclIntDecls.h,v 1.99.2.7 2007/12/11 16:19:55 dgp Exp $ + * RCS: @(#) $Id: tclIntDecls.h,v 1.99.2.8 2008/01/25 16:43:53 dgp Exp $ */ #ifndef _TCLINTDECLS @@ -889,13 +889,7 @@ EXTERN struct tm * TclpGmtime (CONST time_t * clock); /* Slot 194 is reserved */ /* Slot 195 is reserved */ /* Slot 196 is reserved */ -#ifndef TclCompEvalObj_TCL_DECLARED -#define TclCompEvalObj_TCL_DECLARED -/* 197 */ -EXTERN int TclCompEvalObj (Tcl_Interp * interp, - Tcl_Obj * objPtr, CONST CmdFrame* invoker, - int word); -#endif +/* Slot 197 is reserved */ #ifndef TclObjGetFrame_TCL_DECLARED #define TclObjGetFrame_TCL_DECLARED /* 198 */ @@ -1308,7 +1302,7 @@ typedef struct TclIntStubs { void *reserved194; void *reserved195; void *reserved196; - int (*tclCompEvalObj) (Tcl_Interp * interp, Tcl_Obj * objPtr, CONST CmdFrame* invoker, int word); /* 197 */ + void *reserved197; int (*tclObjGetFrame) (Tcl_Interp * interp, Tcl_Obj * objPtr, CallFrame ** framePtrPtr); /* 198 */ void *reserved199; int (*tclpObjRemoveDirectory) (Tcl_Obj * pathPtr, int recursive, Tcl_Obj ** errorPtr); /* 200 */ @@ -1966,10 +1960,7 @@ extern TclIntStubs *tclIntStubsPtr; /* Slot 194 is reserved */ /* Slot 195 is reserved */ /* Slot 196 is reserved */ -#ifndef TclCompEvalObj -#define TclCompEvalObj \ - (tclIntStubsPtr->tclCompEvalObj) /* 197 */ -#endif +/* Slot 197 is reserved */ #ifndef TclObjGetFrame #define TclObjGetFrame \ (tclIntStubsPtr->tclObjGetFrame) /* 198 */ diff --git a/generic/tclParse.c b/generic/tclParse.c index 8c1e248..1ea471c 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.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: tclParse.c,v 1.52.2.7 2007/11/21 06:30:54 dgp Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.52.2.8 2008/01/25 16:43:53 dgp Exp $ */ #include "tclInt.h" @@ -198,7 +198,7 @@ static int ParseWhiteSpace(const char *src, int numBytes, void TclParseInit( Tcl_Interp *interp, /* Interpreter to use for error reporting */ - const char *string, /* String to be parsed. */ + const char *start, /* Start of string to be parsed. */ int numBytes, /* Total number of bytes in string. If < 0, * the script consists of all bytes up to the * first null character. */ @@ -208,8 +208,8 @@ TclParseInit( parsePtr->tokenPtr = parsePtr->staticTokens; parsePtr->numTokens = 0; parsePtr->tokensAvailable = NUM_STATIC_TOKENS; - parsePtr->string = string; - parsePtr->end = string + numBytes; + parsePtr->string = start; + parsePtr->end = start + numBytes; parsePtr->term = parsePtr->end; parsePtr->interp = interp; parsePtr->incomplete = 0; @@ -315,9 +315,7 @@ Tcl_ParseCommand( * Create the token for the word. */ - if (parsePtr->numTokens == parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 1); wordIndex = parsePtr->numTokens; tokenPtr = &parsePtr->tokenPtr[wordIndex]; tokenPtr->type = TCL_TOKEN_WORD; @@ -493,12 +491,14 @@ Tcl_ParseCommand( * tokens representing the expanded list. */ + int growthNeeded = wordIndex + 2*elemCount + - parsePtr->numTokens; parsePtr->numWords += elemCount - 1; - parsePtr->numTokens = wordIndex + 2*elemCount; - while (parsePtr->numTokens >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); + if (growthNeeded > 0) { + TclGrowParseTokenArray(parsePtr, growthNeeded); + tokenPtr = &parsePtr->tokenPtr[wordIndex]; } - tokenPtr = &parsePtr->tokenPtr[wordIndex]; + parsePtr->numTokens = wordIndex + 2*elemCount; /* * Generate a TCL_TOKEN_SIMPLE_WORD token sequence for @@ -1039,7 +1039,7 @@ ParseTokens( * termination information. */ { char type; - int originalTokens, varToken; + int originalTokens; int noSubstCmds = !(flags & TCL_SUBST_COMMANDS); int noSubstVars = !(flags & TCL_SUBST_VARIABLES); int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES); @@ -1054,9 +1054,7 @@ ParseTokens( originalTokens = parsePtr->numTokens; while (numBytes && !((type = CHAR_TYPE(*src)) & mask)) { - if (parsePtr->numTokens == parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 1); tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->start = src; tokenPtr->numComponents = 0; @@ -1075,6 +1073,8 @@ ParseTokens( tokenPtr->size = src - tokenPtr->start; parsePtr->numTokens++; } else if (*src == '$') { + int varToken; + if (noSubstVars) { tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->size = 1; @@ -1085,7 +1085,7 @@ ParseTokens( } /* - * This is a variable reference. Call Tcl_ParseVarName to do all + * This is a variable reference. Call Tcl_ParseVarName to do all * the dirty work of parsing the name. */ @@ -1109,7 +1109,7 @@ ParseTokens( } /* - * Command substitution. Call Tcl_ParseCommand recursively (and + * Command substitution. Call Tcl_ParseCommand recursively (and * repeatedly) to parse the nested command(s), then throw away the * parse information. */ @@ -1225,9 +1225,7 @@ ParseTokens( * empty range, so that there is always at least one token added. */ - if (parsePtr->numTokens == parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 1); tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->start = src; tokenPtr->numComponents = 0; @@ -1273,46 +1271,6 @@ Tcl_FreeParse( /* *---------------------------------------------------------------------- * - * TclExpandTokenArray -- - * - * This function is invoked when the current space for tokens in a - * Tcl_Parse structure fills up; it allocates memory to grow the token - * array - * - * Results: - * None. - * - * Side effects: - * Memory is allocated for a new larger token array; the memory for the - * old array is freed, if it had been dynamically allocated. - * - *---------------------------------------------------------------------- - */ - -void -TclExpandTokenArray( - Tcl_Parse *parsePtr) /* Parse structure whose token space has - * overflowed. */ -{ - int newCount = parsePtr->tokensAvailable*2; - - if (parsePtr->tokenPtr != parsePtr->staticTokens) { - parsePtr->tokenPtr = (Tcl_Token *) ckrealloc((char *) - parsePtr->tokenPtr, newCount * sizeof(Tcl_Token)); - } else { - Tcl_Token *newPtr = (Tcl_Token *) - ckalloc(newCount * sizeof(Tcl_Token)); - - memcpy(newPtr, parsePtr->tokenPtr, - (size_t) parsePtr->tokensAvailable * sizeof(Tcl_Token)); - parsePtr->tokenPtr = newPtr; - } - parsePtr->tokensAvailable = newCount; -} - -/* - *---------------------------------------------------------------------- - * * Tcl_ParseVarName -- * * Given a string starting with a $ sign, parse off a variable name and @@ -1377,9 +1335,7 @@ Tcl_ParseVarName( */ src = start; - if (parsePtr->numTokens+2 > parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 2); tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->type = TCL_TOKEN_VARIABLE; tokenPtr->start = src; @@ -1671,9 +1627,7 @@ Tcl_ParseBraces( src = start; startIndex = parsePtr->numTokens; - if (parsePtr->numTokens == parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 1); tokenPtr = &parsePtr->tokenPtr[startIndex]; tokenPtr->type = TCL_TOKEN_TEXT; tokenPtr->start = src+1; @@ -1736,9 +1690,7 @@ Tcl_ParseBraces( if (tokenPtr->size != 0) { parsePtr->numTokens++; } - if ((parsePtr->numTokens+1) >= parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 2); tokenPtr = &parsePtr->tokenPtr[parsePtr->numTokens]; tokenPtr->type = TCL_TOKEN_BS; tokenPtr->start = src; @@ -2070,9 +2022,7 @@ Tcl_SubstObj( * got parsed. */ - if (parsePtr->numTokens == parsePtr->tokensAvailable) { - TclExpandTokenArray(parsePtr); - } + TclGrowParseTokenArray(parsePtr, 1); tokenPtr = &(parsePtr->tokenPtr[parsePtr->numTokens]); tokenPtr->start = parsePtr->term; tokenPtr->numComponents = 0; diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c index 3e2be97..8c41d20 100644 --- a/generic/tclStubInit.c +++ b/generic/tclStubInit.c @@ -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: tclStubInit.c,v 1.140.2.6 2007/12/11 16:19:56 dgp Exp $ + * RCS: @(#) $Id: tclStubInit.c,v 1.140.2.7 2008/01/25 16:43:57 dgp Exp $ */ #include "tclInt.h" @@ -295,7 +295,7 @@ TclIntStubs tclIntStubs = { NULL, /* 194 */ NULL, /* 195 */ NULL, /* 196 */ - TclCompEvalObj, /* 197 */ + NULL, /* 197 */ TclObjGetFrame, /* 198 */ NULL, /* 199 */ TclpObjRemoveDirectory, /* 200 */ -- cgit v0.12