summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog21
-rw-r--r--generic/tclBasic.c9
-rw-r--r--generic/tclCompCmds.c35
-rw-r--r--generic/tclCompExpr.c24
-rw-r--r--generic/tclCompile.c5
-rw-r--r--generic/tclCompile.h9
-rw-r--r--generic/tclExecute.c15
-rw-r--r--generic/tclIOUtil.c18
-rw-r--r--generic/tclInt.decls11
-rw-r--r--generic/tclInt.h49
-rw-r--r--generic/tclIntDecls.h17
-rw-r--r--generic/tclParse.c94
-rw-r--r--generic/tclStubInit.c4
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 <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.
+
+ * generic/tclIntDecls.h: make genstubs
+ * generic/tclStubInit.c:
+
2008-01-22 Don Porter <dgp@users.sourceforge.net>
* 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; 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 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 */
generated by cgit v0.12 at 2024-12-03 18:49:46 (GMT)