diff options
| -rw-r--r-- | ChangeLog | 13 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 35 | ||||
| -rw-r--r-- | generic/tclCompExpr.c | 24 | ||||
| -rw-r--r-- | generic/tclInt.h | 49 | ||||
| -rw-r--r-- | generic/tclParse.c | 80 |
5 files changed, 96 insertions, 105 deletions
@@ -1,5 +1,18 @@ 2008-01-23 Don Porter <dgp@users.sourceforge.net> + * 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. diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 83bb1ae..5b5cd93 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.139 2007/12/23 21:29:41 hobbs Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.140 2008/01/23 19:41:27 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; i<synthetic.numWords; i++) { + int toCopy; + tokenPtr = TokenAfter(tokenPtr); + toCopy = tokenPtr->numComponents + 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 5039218..d935747 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.94 2008/01/17 17:45:51 dgp Exp $ + * RCS: @(#) $Id: tclCompExpr.c,v 1.95 2008/01/23 19:41:28 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/tclInt.h b/generic/tclInt.h index b89b7b0..975771f 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.359 2007/12/17 15:28:27 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.360 2008/01/23 19:41:28 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: + * + * EXTERN void TclGrowTokenArray _ANSI_ARGS_((Tcl_Token *tokenPtr, + * int used, int available, int append, + * Tcl_Token *staticPtr)); + * EXTERN void TclGrowParseTokenArray _ANSI_ARGS_((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/tclParse.c b/generic/tclParse.c index 9f09f4a..732955c 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.60 2007/12/13 15:23:19 dgp Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.61 2008/01/23 19:41:29 dgp Exp $ */ #include "tclInt.h" @@ -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 @@ -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; @@ -1225,9 +1223,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 +1269,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 +1333,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 +1625,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 +1688,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 +2020,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; |