summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--ChangeLog13
-rw-r--r--generic/tclCompCmds.c35
-rw-r--r--generic/tclCompExpr.c24
-rw-r--r--generic/tclInt.h49
-rw-r--r--generic/tclParse.c80
5 files changed, 96 insertions, 105 deletions
diff --git a/ChangeLog b/ChangeLog
index 0972303..30271f5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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;