summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2007-06-21 18:41:16 (GMT)
committerdgp <dgp@users.sourceforge.net>2007-06-21 18:41:16 (GMT)
commitabe71b0d5a315b3f7fa348e2318547e5180ef089 (patch)
tree7de5b3b13fb94070c2bc1d7014d0e9ec3a4fa5bd
parent1cf3fb4fff5a0437a76e658e7ed16ef5928cc974 (diff)
downloadtcl-abe71b0d5a315b3f7fa348e2318547e5180ef089.zip
tcl-abe71b0d5a315b3f7fa348e2318547e5180ef089.tar.gz
tcl-abe71b0d5a315b3f7fa348e2318547e5180ef089.tar.bz2
* generic/tclBasic.c: Move most instances of the Tcl_Parse struct
* generic/tclCompExpr.c: off the C stack and onto the Tcl stack. * generic/tclCompile.c: This is a rather large struct (> 3kB). * generic/tclParse.c:
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclBasic.c55
-rw-r--r--generic/tclCompExpr.c173
-rw-r--r--generic/tclCompile.c66
-rw-r--r--generic/tclParse.c154
5 files changed, 243 insertions, 212 deletions
diff --git a/ChangeLog b/ChangeLog
index f545158..7051815 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2007-06-21 Don Porter <dgp@users.sourceforge.net>
+
+ * generic/tclBasic.c: Move most instances of the Tcl_Parse struct
+ * generic/tclCompExpr.c: off the C stack and onto the Tcl stack.
+ * generic/tclCompile.c: This is a rather large struct (> 3kB).
+ * generic/tclParse.c:
+
2007-06-21 Miguel Sofer <msofer@users.sf.net>
* generic/tclBasic.c (TEOvI): Made sure that leave
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index fc474d0..ac3b5f8 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.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: tclBasic.c,v 1.255 2007/06/21 17:45:39 msofer Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.256 2007/06/21 18:41:16 dgp Exp $
*/
#include "tclInt.h"
@@ -3897,7 +3897,6 @@ TclEvalEx(
{
Interp *iPtr = (Interp *) interp;
const char *p, *next;
- Tcl_Parse parse;
#define NUM_STATIC_OBJS 20
Tcl_Obj *staticObjArray[NUM_STATIC_OBJS], **objv, **objvSpace;
int expandStatic[NUM_STATIC_OBJS], *expand;
@@ -3914,6 +3913,7 @@ TclEvalEx(
* the script, so that it can be freed
* properly if an error occurs. */
+ Tcl_Parse *parsePtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
CmdFrame *eeFramePtr = (CmdFrame *) TclStackAlloc(interp, sizeof(CmdFrame));
/* TIP #280 Structures for tracking of command
* locations. */
@@ -4003,7 +4003,7 @@ TclEvalEx(
iPtr->evalFlags = 0;
do {
- if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) != TCL_OK) {
+ if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
code = TCL_ERROR;
goto error;
}
@@ -4014,38 +4014,36 @@ TclEvalEx(
* block.
*/
- TclAdvanceLines(&line, p, parse.commandStart);
+ TclAdvanceLines(&line, p, parsePtr->commandStart);
gotParse = 1;
- if (parse.numWords > 0) {
+ if (parsePtr->numWords > 0) {
/*
* TIP #280. Track lines within the words of the current
* command.
*/
int wordLine = line;
- const char *wordStart = parse.commandStart;
+ const char *wordStart = parsePtr->commandStart;
/*
* Generate an array of objects for the words of the command.
*/
int objectsNeeded = 0;
+ unsigned int numWords = parsePtr->numWords;
- if (parse.numWords > NUM_STATIC_OBJS) {
- expand = (int *)
- ckalloc((unsigned) parse.numWords * sizeof(int));
- objvSpace = (Tcl_Obj **)
- ckalloc((unsigned) parse.numWords * sizeof(Tcl_Obj *));
- lineSpace = (int *)
- ckalloc((unsigned) parse.numWords * sizeof(int));
+ if (numWords > NUM_STATIC_OBJS) {
+ expand = (int *) ckalloc(numWords * sizeof(int));
+ objvSpace = (Tcl_Obj **) ckalloc(numWords * sizeof(Tcl_Obj *));
+ lineSpace = (int *) ckalloc(numWords * sizeof(int));
}
expandRequested = 0;
objv = objvSpace;
lines = lineSpace;
- for (objectsUsed = 0, tokenPtr = parse.tokenPtr;
- objectsUsed < parse.numWords;
+ for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr;
+ objectsUsed < numWords;
objectsUsed++, tokenPtr += (tokenPtr->numComponents + 1)) {
/*
* TIP #280. Track lines to current word. Save the information
@@ -4106,10 +4104,10 @@ TclEvalEx(
Tcl_Obj **copy = objvSpace;
int *lcopy = lineSpace;
- int wordIdx = parse.numWords;
+ int wordIdx = numWords;
int objIdx = objectsNeeded - 1;
- if ((parse.numWords > NUM_STATIC_OBJS)
+ if ((numWords > NUM_STATIC_OBJS)
|| (objectsNeeded > NUM_STATIC_OBJS)) {
objv = objvSpace = (Tcl_Obj **)
ckalloc((unsigned)objectsNeeded*sizeof(Tcl_Obj*));
@@ -4158,10 +4156,10 @@ TclEvalEx(
* have been executed.
*/
- eeFramePtr->cmd.str.cmd = parse.commandStart;
- eeFramePtr->cmd.str.len = parse.commandSize;
+ eeFramePtr->cmd.str.cmd = parsePtr->commandStart;
+ eeFramePtr->cmd.str.len = parsePtr->commandSize;
- if (parse.term == parse.commandStart + parse.commandSize - 1) {
+ if (parsePtr->term == parsePtr->commandStart + parsePtr->commandSize - 1) {
eeFramePtr->cmd.str.len--;
}
@@ -4171,7 +4169,7 @@ TclEvalEx(
iPtr->cmdFramePtr = eeFramePtr;
iPtr->numLevels++;
code = TclEvalObjvInternal(interp, objectsUsed, objv,
- parse.commandStart, parse.commandSize, 0);
+ parsePtr->commandStart, parsePtr->commandSize, 0);
iPtr->numLevels--;
iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
@@ -4210,11 +4208,11 @@ TclEvalEx(
* executed command.
*/
- next = parse.commandStart + parse.commandSize;
+ next = parsePtr->commandStart + parsePtr->commandSize;
bytesLeft -= next - p;
p = next;
- TclAdvanceLines(&line, parse.commandStart, p);
- Tcl_FreeParse(&parse);
+ TclAdvanceLines(&line, parsePtr->commandStart, p);
+ Tcl_FreeParse(parsePtr);
gotParse = 0;
} while (bytesLeft > 0);
iPtr->varFramePtr = savedVarFramePtr;
@@ -4235,8 +4233,8 @@ TclEvalEx(
}
}
if ((code == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) {
- commandLength = parse.commandSize;
- if (parse.term == parse.commandStart + commandLength - 1) {
+ commandLength = parsePtr->commandSize;
+ if (parsePtr->term == parsePtr->commandStart + commandLength - 1) {
/*
* The terminator character (such as ; or ]) of the command where
* the error occurred is the last character in the parsed command.
@@ -4246,7 +4244,7 @@ TclEvalEx(
commandLength -= 1;
}
- Tcl_LogCommandInfo(interp, script, parse.commandStart, commandLength);
+ Tcl_LogCommandInfo(interp, script, parsePtr->commandStart, commandLength);
}
iPtr->flags &= ~ERR_ALREADY_LOGGED;
@@ -4258,7 +4256,7 @@ TclEvalEx(
Tcl_DecrRefCount(objv[i]);
}
if (gotParse) {
- Tcl_FreeParse(&parse);
+ Tcl_FreeParse(parsePtr);
}
if (objvSpace != staticObjArray) {
ckfree((char *) objvSpace);
@@ -4278,6 +4276,7 @@ TclEvalEx(
Tcl_DecrRefCount(eeFramePtr->data.eval.path);
}
TclStackFree(interp, eeFramePtr);
+ TclStackFree(interp, parsePtr);
return code;
}
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index 7465135..41a62d7 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.54 2007/06/20 18:46:11 dgp Exp $
+ * RCS: @(#) $Id: tclCompExpr.c,v 1.55 2007/06/21 18:41:16 dgp Exp $
*/
#include "tclInt.h"
@@ -443,7 +443,10 @@ ParseExpr(
scanned = tokenPtr->size;
break;
- case SCRIPT:
+ case SCRIPT: {
+ Tcl_Parse *nestedPtr =
+ (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+
tokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
tokenPtr->type = TCL_TOKEN_COMMAND;
tokenPtr->start = start;
@@ -452,19 +455,18 @@ ParseExpr(
end = start + numBytes;
start++;
while (1) {
- Tcl_Parse nested;
code = Tcl_ParseCommand(interp, start, (end - start), 1,
- &nested);
+ nestedPtr);
if (code != TCL_OK) {
- parsePtr->term = nested.term;
- parsePtr->errorType = nested.errorType;
- parsePtr->incomplete = nested.incomplete;
+ parsePtr->term = nestedPtr->term;
+ parsePtr->errorType = nestedPtr->errorType;
+ parsePtr->incomplete = nestedPtr->incomplete;
break;
}
- start = (nested.commandStart + nested.commandSize);
- Tcl_FreeParse(&nested);
- if ((nested.term < end) && (*nested.term == ']')
- && !nested.incomplete) {
+ start = (nestedPtr->commandStart + nestedPtr->commandSize);
+ Tcl_FreeParse(nestedPtr);
+ if ((nestedPtr->term < end) && (*(nestedPtr->term) == ']')
+ && !(nestedPtr->incomplete)) {
break;
}
@@ -477,6 +479,7 @@ ParseExpr(
break;
}
}
+ TclStackFree(interp, nestedPtr);
end = start;
start = tokenPtr->start;
if (code != TCL_OK) {
@@ -489,6 +492,7 @@ ParseExpr(
parsePtr->numTokens++;
break;
}
+ }
tokenPtr = parsePtr->tokenPtr + wordIndex;
tokenPtr->size = scanned;
@@ -1148,10 +1152,11 @@ Tcl_ParseExpr(
OpNode *opTree = NULL; /* Will point to the tree of operators */
Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */
Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/
- Tcl_Parse parse; /* Holds the Tcl_Tokens of substitutions */
-
+ Tcl_Parse *exprParsePtr =
+ (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+ /* Holds the Tcl_Tokens of substitutions */
int code = ParseExpr(interp, start, numBytes, &opTree, litList,
- funcList, &parse);
+ funcList, exprParsePtr);
if (numBytes < 0) {
numBytes = (start ? strlen(start) : 0);
@@ -1160,12 +1165,13 @@ Tcl_ParseExpr(
TclParseInit(interp, start, numBytes, parsePtr);
if (code == TCL_OK) {
ConvertTreeToTokens(interp, start, numBytes, opTree, litList,
- parse.tokenPtr, parsePtr);
+ exprParsePtr->tokenPtr, parsePtr);
} else {
/* TODO: copy over any error info to *parsePtr */
}
- Tcl_FreeParse(&parse);
+ Tcl_FreeParse(exprParsePtr);
+ TclStackFree(interp, exprParsePtr);
Tcl_DecrRefCount(funcList);
Tcl_DecrRefCount(litList);
ckfree((char *) opTree);
@@ -1176,7 +1182,8 @@ Tcl_ParseExpr(
ExprNode *lastOrphanPtr, *nodes = staticNodes;
int nodesAvailable = NUM_STATIC_NODES;
int nodesUsed = 0;
- Tcl_Parse scratch; /* Parsing scratch space */
+ Tcl_Parse *scratchPtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+ /* Parsing scratch space */
Tcl_Obj *msg = NULL, *post = NULL;
int scanned = 0, code = TCL_OK, insertMark = 0;
const char *mark = "_@_";
@@ -1193,7 +1200,7 @@ Tcl_ParseExpr(
numBytes = (start ? strlen(start) : 0);
}
- TclParseInit(interp, start, numBytes, &scratch);
+ TclParseInit(interp, start, numBytes, scratchPtr);
TclParseInit(interp, start, numBytes, parsePtr);
/*
@@ -1324,7 +1331,7 @@ Tcl_ParseExpr(
if ((NODE_TYPE & lastNodePtr->lexeme) == LEAF) {
const char *operand =
- scratch.tokenPtr[lastNodePtr->token].start;
+ scratchPtr->tokenPtr[lastNodePtr->token].start;
msg = Tcl_ObjPrintf("missing operator at %s", mark);
if (operand[0] == '0') {
@@ -1342,32 +1349,32 @@ Tcl_ParseExpr(
continue;
}
- if (scratch.numTokens+1 >= scratch.tokensAvailable) {
- TclExpandTokenArray(&scratch);
+ if (scratchPtr->numTokens+1 >= scratchPtr->tokensAvailable) {
+ TclExpandTokenArray(scratchPtr);
}
- nodePtr->token = scratch.numTokens;
- tokenPtr = scratch.tokenPtr + nodePtr->token;
+ nodePtr->token = scratchPtr->numTokens;
+ tokenPtr = scratchPtr->tokenPtr + nodePtr->token;
tokenPtr->type = TCL_TOKEN_SUB_EXPR;
tokenPtr->start = start;
- scratch.numTokens++;
+ scratchPtr->numTokens++;
switch (nodePtr->lexeme) {
case NUMBER:
case BOOLEAN:
- tokenPtr = scratch.tokenPtr + scratch.numTokens;
+ tokenPtr = scratchPtr->tokenPtr + scratchPtr->numTokens;
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->start = start;
tokenPtr->size = scanned;
tokenPtr->numComponents = 0;
- scratch.numTokens++;
+ scratchPtr->numTokens++;
break;
case QUOTED:
code = Tcl_ParseQuotedString(interp, start, numBytes,
- &scratch, 1, &end);
+ scratchPtr, 1, &end);
if (code != TCL_OK) {
- scanned = scratch.term - start;
+ scanned = scratchPtr->term - start;
scanned += (scanned < numBytes);
continue;
}
@@ -1376,7 +1383,7 @@ Tcl_ParseExpr(
case BRACED:
code = Tcl_ParseBraces(interp, start, numBytes,
- &scratch, 1, &end);
+ scratchPtr, 1, &end);
if (code != TCL_OK) {
continue;
}
@@ -1384,13 +1391,13 @@ Tcl_ParseExpr(
break;
case VARIABLE:
- code = Tcl_ParseVarName(interp, start, numBytes, &scratch, 1);
+ code = Tcl_ParseVarName(interp, start, numBytes, scratchPtr, 1);
if (code != TCL_OK) {
- scanned = scratch.term - start;
+ scanned = scratchPtr->term - start;
scanned += (scanned < numBytes);
continue;
}
- tokenPtr = scratch.tokenPtr + nodePtr->token + 1;
+ tokenPtr = scratchPtr->tokenPtr + nodePtr->token + 1;
if (tokenPtr->type != TCL_TOKEN_VARIABLE) {
TclNewLiteralStringObj(msg, "invalid character \"$\"");
code = TCL_ERROR;
@@ -1399,8 +1406,10 @@ Tcl_ParseExpr(
scanned = tokenPtr->size;
break;
- case SCRIPT:
- tokenPtr = scratch.tokenPtr + scratch.numTokens;
+ case SCRIPT: {
+ Tcl_Parse *nestedPtr =
+ (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+ tokenPtr = scratchPtr->tokenPtr + scratchPtr->numTokens;
tokenPtr->type = TCL_TOKEN_COMMAND;
tokenPtr->start = start;
tokenPtr->numComponents = 0;
@@ -1408,19 +1417,18 @@ Tcl_ParseExpr(
end = start + numBytes;
start++;
while (1) {
- Tcl_Parse nested;
code = Tcl_ParseCommand(interp,
- start, (end - start), 1, &nested);
+ start, (end - start), 1, nestedPtr);
if (code != TCL_OK) {
- parsePtr->term = nested.term;
- parsePtr->errorType = nested.errorType;
- parsePtr->incomplete = nested.incomplete;
+ parsePtr->term = nestedPtr->term;
+ parsePtr->errorType = nestedPtr->errorType;
+ parsePtr->incomplete = nestedPtr->incomplete;
break;
}
- start = (nested.commandStart + nested.commandSize);
- Tcl_FreeParse(&nested);
- if ((nested.term < end) && (*nested.term == ']')
- && !nested.incomplete) {
+ start = (nestedPtr->commandStart + nestedPtr->commandSize);
+ Tcl_FreeParse(nestedPtr);
+ if ((nestedPtr->term < end) && (*(nestedPtr->term) == ']')
+ && !(nestedPtr->incomplete)) {
break;
}
@@ -1433,6 +1441,7 @@ Tcl_ParseExpr(
break;
}
}
+ TclStackFree(interp, nestedPtr);
end = start;
start = tokenPtr->start;
if (code != TCL_OK) {
@@ -1442,13 +1451,14 @@ Tcl_ParseExpr(
}
scanned = end - start;
tokenPtr->size = scanned;
- scratch.numTokens++;
+ scratchPtr->numTokens++;
break;
}
+ }
- tokenPtr = scratch.tokenPtr + nodePtr->token;
+ tokenPtr = scratchPtr->tokenPtr + nodePtr->token;
tokenPtr->size = scanned;
- tokenPtr->numComponents = scratch.numTokens - nodePtr->token - 1;
+ tokenPtr->numComponents = scratchPtr->numTokens - nodePtr->token - 1;
nodePtr->left = -1;
nodePtr->right = -1;
@@ -1470,16 +1480,16 @@ Tcl_ParseExpr(
nodePtr->right = -1;
nodePtr->parent = -1;
- if (scratch.numTokens >= scratch.tokensAvailable) {
- TclExpandTokenArray(&scratch);
+ if (scratchPtr->numTokens >= scratchPtr->tokensAvailable) {
+ TclExpandTokenArray(scratchPtr);
}
- nodePtr->token = scratch.numTokens;
- tokenPtr = scratch.tokenPtr + nodePtr->token;
+ nodePtr->token = scratchPtr->numTokens;
+ tokenPtr = scratchPtr->tokenPtr + nodePtr->token;
tokenPtr->type = TCL_TOKEN_OPERATOR;
tokenPtr->start = start;
tokenPtr->size = scanned;
tokenPtr->numComponents = 0;
- scratch.numTokens++;
+ scratchPtr->numTokens++;
lastOrphanPtr = nodePtr;
nodesUsed++;
@@ -1627,7 +1637,7 @@ Tcl_ParseExpr(
* CLOSE_PAREN can only close one OPEN_PAREN.
*/
- tokenPtr = scratch.tokenPtr + otherPtr->token;
+ tokenPtr = scratchPtr->tokenPtr + otherPtr->token;
tokenPtr->size = start + scanned - tokenPtr->start;
break;
}
@@ -1678,16 +1688,16 @@ Tcl_ParseExpr(
nodePtr->right = -1;
- if (scratch.numTokens >= scratch.tokensAvailable) {
- TclExpandTokenArray(&scratch);
+ if (scratchPtr->numTokens >= scratchPtr->tokensAvailable) {
+ TclExpandTokenArray(scratchPtr);
}
- nodePtr->token = scratch.numTokens;
- tokenPtr = scratch.tokenPtr + nodePtr->token;
+ nodePtr->token = scratchPtr->numTokens;
+ tokenPtr = scratchPtr->tokenPtr + nodePtr->token;
tokenPtr->type = TCL_TOKEN_OPERATOR;
tokenPtr->start = start;
tokenPtr->size = scanned;
tokenPtr->numComponents = 0;
- scratch.numTokens++;
+ scratchPtr->numTokens++;
nodePtr->left = lastOrphanPtr - nodes;
nodePtr->parent = lastOrphanPtr->parent;
@@ -1707,7 +1717,7 @@ Tcl_ParseExpr(
* Shift tokens from scratch space to caller space.
*/
- GenerateTokens(nodes, &scratch, parsePtr);
+ GenerateTokens(nodes, scratchPtr, parsePtr);
} else {
if (parsePtr->errorType == TCL_PARSE_SUCCESS) {
parsePtr->errorType = TCL_PARSE_SYNTAX;
@@ -1723,36 +1733,37 @@ Tcl_ParseExpr(
}
Tcl_AppendPrintfToObj(msg,
"\nin expression \"%s%.*s%.*s%s%s%.*s%s\"",
- ((start - limit) < scratch.string) ? "" : "...",
- ((start - limit) < scratch.string)
- ? (start - scratch.string) : limit - 3,
- ((start - limit) < scratch.string)
- ? scratch.string : start - limit + 3,
+ ((start - limit) < scratchPtr->string) ? "" : "...",
+ ((start - limit) < scratchPtr->string)
+ ? (start - scratchPtr->string) : limit - 3,
+ ((start - limit) < scratchPtr->string)
+ ? scratchPtr->string : start - limit + 3,
(scanned < limit) ? scanned : limit - 3, start,
(scanned < limit) ? "" : "...",
insertMark ? mark : "",
- (start + scanned + limit > scratch.end)
- ? scratch.end - (start + scanned) : limit-3,
+ (start + scanned + limit > scratchPtr->end)
+ ? scratchPtr->end - (start + scanned) : limit-3,
start + scanned,
- (start + scanned + limit > scratch.end) ? "" : "...");
+ (start + scanned + limit > scratchPtr->end) ? "" : "...");
if (post != NULL) {
Tcl_AppendToObj(msg, ";\n", -1);
Tcl_AppendObjToObj(msg, post);
Tcl_DecrRefCount(post);
}
Tcl_SetObjResult(interp, msg);
- numBytes = scratch.end - scratch.string;
+ numBytes = scratchPtr->end - scratchPtr->string;
Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
"\n (parsing expression \"%.*s%s\")",
(numBytes < limit) ? numBytes : limit - 3,
- scratch.string, (numBytes < limit) ? "" : "..."));
+ scratchPtr->string, (numBytes < limit) ? "" : "..."));
}
}
if (nodes != staticNodes) {
ckfree((char *)nodes);
}
- Tcl_FreeParse(&scratch);
+ Tcl_FreeParse(scratchPtr);
+ TclStackFree(interp, scratchPtr);
return code;
#endif
}
@@ -2328,10 +2339,12 @@ TclCompileExpr(
OpNode *opTree = NULL; /* Will point to the tree of operators */
Tcl_Obj *litList = Tcl_NewObj(); /* List to hold the literals */
Tcl_Obj *funcList = Tcl_NewObj(); /* List to hold the functon names*/
- Tcl_Parse parse; /* Holds the Tcl_Tokens of substitutions */
+ Tcl_Parse *parsePtr =
+ (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
+ /* Holds the Tcl_Tokens of substitutions */
int code = ParseExpr(interp, script, numBytes, &opTree, litList,
- funcList, &parse);
+ funcList, parsePtr);
if (code == TCL_OK) {
int litObjc, needsNumConversion = 1;
@@ -2346,7 +2359,7 @@ TclCompileExpr(
*/
Tcl_ListObjGetElements(NULL, litList, &litObjc, &litObjv);
- CompileExprTree(interp, opTree, litObjv, funcList, parse.tokenPtr,
+ CompileExprTree(interp, opTree, litObjv, funcList, parsePtr->tokenPtr,
&needsNumConversion, envPtr);
if (needsNumConversion) {
/*
@@ -2360,13 +2373,15 @@ TclCompileExpr(
}
}
- Tcl_FreeParse(&parse);
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
Tcl_DecrRefCount(funcList);
Tcl_DecrRefCount(litList);
ckfree((char *) opTree);
return code;
#else
- Tcl_Parse parse;
+ Tcl_Parse *parsePtr =
+ (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
int needsNumConversion = 1;
/*
@@ -2401,14 +2416,15 @@ TclCompileExpr(
* Parse the expression then compile it.
*/
- if (TCL_OK != Tcl_ParseExpr(interp, script, numBytes, &parse)) {
+ if (TCL_OK != Tcl_ParseExpr(interp, script, numBytes, parsePtr)) {
+ TclStackFree(interp, parsePtr);
return TCL_ERROR;
}
/* TIP #280 : Track Lines within the expression */
- TclAdvanceLines (&envPtr->line, script, parse.tokenPtr->start);
+ TclAdvanceLines (&envPtr->line, script, parsePtr->tokenPtr->start);
- CompileSubExpr(interp, parse.tokenPtr, &needsNumConversion, envPtr);
+ CompileSubExpr(interp, parsePtr->tokenPtr, &needsNumConversion, envPtr);
if (needsNumConversion) {
/*
@@ -2419,7 +2435,8 @@ TclCompileExpr(
TclEmitOpcode(INST_TRY_CVT_TO_NUMERIC, envPtr);
}
- Tcl_FreeParse(&parse);
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
return TCL_OK;
#endif
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index cc917e1..79d0c5b 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.122 2007/06/21 12:43:18 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.123 2007/06/21 18:41:16 dgp Exp $
*/
#include "tclInt.h"
@@ -1112,7 +1112,6 @@ TclCompileScript(
CompileEnv *envPtr) /* Holds resulting instructions. */
{
Interp *iPtr = (Interp *) interp;
- Tcl_Parse parse;
int lastTopLevelCmdIndex = -1;
/* Index of most recent toplevel command in
* the command location table. Initialized to
@@ -1131,6 +1130,7 @@ TclCompileScript(
ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr;
int *wlines;
int wlineat, cmdLine;
+ Tcl_Parse *parsePtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
Tcl_DStringInit(&ds);
@@ -1156,7 +1156,7 @@ TclCompileScript(
gotParse = 0;
cmdLine = envPtr->line;
do {
- if (Tcl_ParseCommand(interp, p, bytesLeft, 0, &parse) != TCL_OK) {
+ if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) {
/*
* Compile bytecodes to report the parse error at runtime.
*/
@@ -1166,7 +1166,8 @@ TclCompileScript(
Tcl_Obj *errInfo = Tcl_DuplicateObj(errMsg);
char *cmdString;
int cmdLength;
- Tcl_Parse subParse;
+ Tcl_Parse *subParsePtr =
+ (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
int errorLine = 1;
TclNewLiteralStringObj(returnCmd,
@@ -1174,15 +1175,16 @@ TclCompileScript(
Tcl_IncrRefCount(returnCmd);
Tcl_IncrRefCount(errInfo);
Tcl_AppendToObj(errInfo, "\n while executing\n\"", -1);
- Tcl_AppendLimitedToObj(errInfo, parse.commandStart,
+ Tcl_AppendLimitedToObj(errInfo, parsePtr->commandStart,
/* Drop the command terminator (";","]") if appropriate */
- (parse.term == parse.commandStart + parse.commandSize - 1)?
- parse.commandSize - 1 : parse.commandSize, 153, NULL);
+ (parsePtr->term ==
+ parsePtr->commandStart + parsePtr->commandSize - 1)?
+ parsePtr->commandSize - 1 : parsePtr->commandSize, 153, NULL);
Tcl_AppendToObj(errInfo, "\"", -1);
Tcl_ListObjAppendElement(NULL, returnCmd, errInfo);
- for (p = envPtr->source; p != parse.commandStart; p++) {
+ for (p = envPtr->source; p != parsePtr->commandStart; p++) {
if (*p == '\n') {
errorLine++;
}
@@ -1196,14 +1198,15 @@ TclCompileScript(
Tcl_DecrRefCount(errInfo);
cmdString = Tcl_GetStringFromObj(returnCmd, &cmdLength);
- Tcl_ParseCommand(interp, cmdString, cmdLength, 0, &subParse);
- TclCompileReturnCmd(interp, &subParse, envPtr);
+ Tcl_ParseCommand(interp, cmdString, cmdLength, 0, subParsePtr);
+ TclCompileReturnCmd(interp, subParsePtr, envPtr);
Tcl_DecrRefCount(returnCmd);
- Tcl_FreeParse(&subParse);
- return;
+ Tcl_FreeParse(subParsePtr);
+ TclStackFree(interp, subParsePtr);
+ break;
}
gotParse = 1;
- if (parse.numWords > 0) {
+ if (parsePtr->numWords > 0) {
int expand = 0; /* Set if there are dynamic expansions
* to handle */
@@ -1224,8 +1227,8 @@ TclCompileScript(
* Determine the actual length of the command.
*/
- commandLength = parse.commandSize;
- if (parse.term == parse.commandStart + commandLength - 1) {
+ commandLength = parsePtr->commandSize;
+ if (parsePtr->term == parsePtr->commandStart + commandLength - 1) {
/*
* The command terminator character (such as ; or ]) is the
* last character in the parsed command. Reduce the length by
@@ -1243,7 +1246,7 @@ TclCompileScript(
if ((tclTraceCompile >= 1) && (envPtr->procPtr == NULL)) {
fprintf(stdout, " Compiling: ");
- TclPrintSource(stdout, parse.commandStart,
+ TclPrintSource(stdout, parsePtr->commandStart,
TclMin(commandLength, 55));
fprintf(stdout, "\n");
}
@@ -1254,8 +1257,8 @@ TclCompileScript(
* words.
*/
- for (wordIdx = 0, tokenPtr = parse.tokenPtr;
- wordIdx < parse.numWords;
+ for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
+ wordIdx < parsePtr->numWords;
wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
if (tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
expand = 1;
@@ -1268,7 +1271,7 @@ TclCompileScript(
lastTopLevelCmdIndex = currCmdIndex;
startCodeOffset = (envPtr->codeNext - envPtr->codeStart);
EnterCmdStartData(envPtr, currCmdIndex,
- parse.commandStart - envPtr->source, startCodeOffset);
+ parsePtr->commandStart - envPtr->source, startCodeOffset);
/*
* Should only start issuing instructions after the "command has
@@ -1287,10 +1290,10 @@ TclCompileScript(
* 'wlines'.
*/
- TclAdvanceLines(&cmdLine, p, parse.commandStart);
- EnterCmdWordData(eclPtr, parse.commandStart - envPtr->source,
- parse.tokenPtr, parse.commandStart, parse.commandSize,
- parse.numWords, cmdLine, &wlines);
+ TclAdvanceLines(&cmdLine, p, parsePtr->commandStart);
+ EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source,
+ parsePtr->tokenPtr, parsePtr->commandStart, parsePtr->commandSize,
+ parsePtr->numWords, cmdLine, &wlines);
wlineat = eclPtr->nuloc - 1;
/*
@@ -1298,8 +1301,8 @@ TclCompileScript(
* command.
*/
- for (wordIdx = 0, tokenPtr = parse.tokenPtr;
- wordIdx < parse.numWords; wordIdx++,
+ for (wordIdx = 0, tokenPtr = parsePtr->tokenPtr;
+ wordIdx < parsePtr->numWords; wordIdx++,
tokenPtr += (tokenPtr->numComponents + 1)) {
envPtr->line = eclPtr->loc[wlineat].line[wordIdx];
@@ -1378,7 +1381,7 @@ TclCompileScript(
}
}
- code = (cmdPtr->compileProc)(interp, &parse, envPtr);
+ code = (cmdPtr->compileProc)(interp, parsePtr, envPtr);
if (code == TCL_OK) {
if (update) {
@@ -1420,7 +1423,7 @@ TclCompileScript(
TclSetCmdNameObj(interp,
envPtr->literalArrayPtr[objIndex].objPtr,cmdPtr);
}
- if ((wordIdx == 0) && (parse.numWords == 1)) {
+ if ((wordIdx == 0) && (parsePtr->numWords == 1)) {
/*
* Single word script: unshare the command name to
* avoid shimmering between bytecode and cmdName
@@ -1485,13 +1488,13 @@ TclCompileScript(
ckfree((char *) eclPtr->loc[wlineat].line);
eclPtr->loc[wlineat].line = wlines;
- } /* end if parse.numWords > 0 */
+ } /* end if parsePtr->numWords > 0 */
/*
* Advance to the next command in the script.
*/
- next = parse.commandStart + parse.commandSize;
+ next = parsePtr->commandStart + parsePtr->commandSize;
bytesLeft -= next - p;
p = next;
@@ -1499,8 +1502,8 @@ TclCompileScript(
* TIP #280: Track lines in the just compiled command.
*/
- TclAdvanceLines(&cmdLine, parse.commandStart, p);
- Tcl_FreeParse(&parse);
+ TclAdvanceLines(&cmdLine, parsePtr->commandStart, p);
+ Tcl_FreeParse(parsePtr);
gotParse = 0;
} while (bytesLeft > 0);
@@ -1520,6 +1523,7 @@ TclCompileScript(
}
envPtr->numSrcBytes = (p - script);
+ TclStackFree(interp, parsePtr);
Tcl_DStringFree(&ds);
}
diff --git a/generic/tclParse.c b/generic/tclParse.c
index 0f63a75..721db7d 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.54 2007/06/06 23:07:06 msofer Exp $
+ * RCS: @(#) $Id: tclParse.c,v 1.55 2007/06/21 18:41:16 dgp Exp $
*/
#include "tclInt.h"
@@ -174,10 +174,10 @@ static CONST char charTypeTable[] = {
static int CommandComplete(CONST char *script, int numBytes);
static int ParseComment(CONST char *src, int numBytes,
Tcl_Parse *parsePtr);
-static int ParseTokens(CONST char *src, int numBytes,
+static int ParseTokens(Tcl_Interp *interp, CONST char *src, int numBytes,
int mask, int flags, Tcl_Parse *parsePtr);
static int ParseWhiteSpace(CONST char *src, int numBytes,
- Tcl_Parse *parsePtr, char *typePtr);
+ int *incompletePtr, char *typePtr);
/*
*----------------------------------------------------------------------
@@ -327,7 +327,7 @@ Tcl_ParseCommand(
* sequence: it should be treated just like white space.
*/
- scanned = ParseWhiteSpace(src, numBytes, parsePtr, &type);
+ scanned = ParseWhiteSpace(src, numBytes, &(parsePtr->incomplete), &type);
src += scanned;
numBytes -= scanned;
if (numBytes == 0) {
@@ -383,8 +383,8 @@ Tcl_ParseCommand(
&& (expPtr->start[0] == '*'))
)
/* Is the prefix */
- && (numBytes > 0)
- && (ParseWhiteSpace(termPtr, numBytes, parsePtr, &type) == 0)
+ && (numBytes > 0) && (0 ==
+ ParseWhiteSpace(termPtr, numBytes, &(parsePtr->incomplete), &type))
&& (type != TYPE_COMMAND_END)
/* Non-whitespace follows */
) {
@@ -398,7 +398,7 @@ Tcl_ParseCommand(
* the work.
*/
- if (ParseTokens(src, numBytes, TYPE_SPACE|terminators,
+ if (ParseTokens(interp, src, numBytes, TYPE_SPACE|terminators,
TCL_SUBST_ALL, parsePtr) != TCL_OK) {
goto error;
}
@@ -562,7 +562,7 @@ Tcl_ParseCommand(
* word), and (b) check for the end of the command.
*/
- scanned = ParseWhiteSpace(src, numBytes, parsePtr, &type);
+ scanned = ParseWhiteSpace(src, numBytes, &(parsePtr->incomplete), &type);
if (scanned) {
src += scanned;
numBytes -= scanned;
@@ -628,9 +628,8 @@ static int
ParseWhiteSpace(
CONST char *src, /* First character to parse. */
register int numBytes, /* Max number of bytes to scan. */
- Tcl_Parse *parsePtr, /* Information about parse in progress.
- * Updated if parsing indicates an incomplete
- * command. */
+ int *incompletePtr, /* Set this boolean memory to true if parsing
+ * indicates an incomplete command. */
char *typePtr) /* Points to location to store character type
* of character that ends run of whitespace */
{
@@ -654,7 +653,7 @@ ParseWhiteSpace(
}
p+=2;
if (--numBytes == 0) {
- parsePtr->incomplete = 1;
+ *incompletePtr = 1;
break;
}
continue;
@@ -684,9 +683,7 @@ TclParseAllWhiteSpace(
CONST char *src, /* First character to parse. */
int numBytes) /* Max number of byes to scan */
{
- Tcl_Parse dummy; /* Since we know ParseWhiteSpace() generates
- * no tokens, there's no need for a call to
- * Tcl_FreeParse() in this routine. */
+ int dummy;
char type;
CONST char *p = src;
@@ -975,7 +972,7 @@ ParseComment(
while (numBytes) {
if (*p == '\\') {
- scanned = ParseWhiteSpace(p, numBytes, parsePtr, &type);
+ scanned = ParseWhiteSpace(p, numBytes, &(parsePtr->incomplete), &type);
if (scanned) {
p += scanned;
numBytes -= scanned;
@@ -1031,6 +1028,7 @@ ParseComment(
static int
ParseTokens(
+ Tcl_Interp *interp,
register CONST char *src, /* First character to parse. */
register int numBytes, /* Max number of bytes to scan. */
int mask, /* Specifies when to stop parsing. The parse
@@ -1051,7 +1049,6 @@ ParseTokens(
int noSubstVars = !(flags & TCL_SUBST_VARIABLES);
int noSubstBS = !(flags & TCL_SUBST_BACKSLASHES);
Tcl_Token *tokenPtr;
- Tcl_Parse nested;
/*
* Each iteration through the following loop adds one token of type
@@ -1105,6 +1102,8 @@ ParseTokens(
src += parsePtr->tokenPtr[varToken].size;
numBytes -= parsePtr->tokenPtr[varToken].size;
} else if (*src == '[') {
+ Tcl_Parse *nestedPtr;
+
if (noSubstCmds) {
tokenPtr->type = TCL_TOKEN_TEXT;
tokenPtr->size = 1;
@@ -1122,25 +1121,19 @@ ParseTokens(
src++;
numBytes--;
+ nestedPtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
while (1) {
if (Tcl_ParseCommand(parsePtr->interp, src,
- numBytes, 1, &nested) != TCL_OK) {
- parsePtr->errorType = nested.errorType;
- parsePtr->term = nested.term;
- parsePtr->incomplete = nested.incomplete;
+ numBytes, 1, nestedPtr) != TCL_OK) {
+ parsePtr->errorType = nestedPtr->errorType;
+ parsePtr->term = nestedPtr->term;
+ parsePtr->incomplete = nestedPtr->incomplete;
+ TclStackFree(interp, nestedPtr);
return TCL_ERROR;
}
- src = nested.commandStart + nested.commandSize;
+ src = nestedPtr->commandStart + nestedPtr->commandSize;
numBytes = parsePtr->end - src;
-
- /*
- * This is equivalent to Tcl_FreeParse(&nested), but
- * presumably inlined here for sake of runtime optimization
- */
-
- if (nested.tokenPtr != nested.staticTokens) {
- ckfree((char *) nested.tokenPtr);
- }
+ Tcl_FreeParse(nestedPtr);
/*
* Check for the closing ']' that ends the command
@@ -1148,8 +1141,8 @@ ParseTokens(
* parsed command.
*/
- if ((nested.term < parsePtr->end) && (*nested.term == ']')
- && !nested.incomplete) {
+ if ((nestedPtr->term < parsePtr->end) && (*(nestedPtr->term) == ']')
+ && !(nestedPtr->incomplete)) {
break;
}
if (numBytes == 0) {
@@ -1160,9 +1153,11 @@ ParseTokens(
parsePtr->errorType = TCL_PARSE_MISSING_BRACKET;
parsePtr->term = tokenPtr->start;
parsePtr->incomplete = 1;
+ TclStackFree(interp, nestedPtr);
return TCL_ERROR;
}
}
+ TclStackFree(interp, nestedPtr);
tokenPtr->type = TCL_TOKEN_COMMAND;
tokenPtr->size = src - tokenPtr->start;
parsePtr->numTokens++;
@@ -1493,7 +1488,7 @@ Tcl_ParseVarName(
* any number of substitutions.
*/
- if (TCL_OK != ParseTokens(src+1, numBytes-1, TYPE_CLOSE_PAREN,
+ if (TCL_OK != ParseTokens(interp, src+1, numBytes-1, TYPE_CLOSE_PAREN,
TCL_SUBST_ALL, parsePtr)) {
goto error;
}
@@ -1563,26 +1558,29 @@ Tcl_ParseVar(
* in with character just after last
* one in the variable specifier. */
{
- Tcl_Parse parse;
register Tcl_Obj *objPtr;
int code;
+ Tcl_Parse *parsePtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
- if (Tcl_ParseVarName(interp, start, -1, &parse, 0) != TCL_OK) {
+ if (Tcl_ParseVarName(interp, start, -1, parsePtr, 0) != TCL_OK) {
+ TclStackFree(interp, parsePtr);
return NULL;
}
if (termPtr != NULL) {
- *termPtr = start + parse.tokenPtr->size;
+ *termPtr = start + parsePtr->tokenPtr->size;
}
- if (parse.numTokens == 1) {
+ if (parsePtr->numTokens == 1) {
/*
* There isn't a variable name after all: the $ is just a $.
*/
+ TclStackFree(interp, parsePtr);
return "$";
}
- code = TclSubstTokens(interp, parse.tokenPtr, parse.numTokens, NULL, 1);
+ code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, NULL, 1);
+ TclStackFree(interp, parsePtr);
if (code != TCL_OK) {
return NULL;
}
@@ -1872,7 +1870,7 @@ Tcl_ParseQuotedString(
TclParseInit(interp, start, numBytes, parsePtr);
}
- if (TCL_OK != ParseTokens(start+1, numBytes-1, TYPE_QUOTE,
+ if (TCL_OK != ParseTokens(interp, start+1, numBytes-1, TYPE_QUOTE,
TCL_SUBST_ALL, parsePtr)) {
goto error;
}
@@ -1920,13 +1918,13 @@ Tcl_SubstObj(
int flags) /* What substitutions to do. */
{
int length, tokensLeft, code;
- Tcl_Parse parse;
Tcl_Token *endTokenPtr;
Tcl_Obj *result;
Tcl_Obj *errMsg = NULL;
CONST char *p = Tcl_GetStringFromObj(objPtr, &length);
+ Tcl_Parse *parsePtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
- TclParseInit(interp, p, length, &parse);
+ TclParseInit(interp, p, length, parsePtr);
/*
* First parse the string rep of objPtr, as if it were enclosed as a
@@ -1934,7 +1932,7 @@ Tcl_SubstObj(
* inhibit types of substitution.
*/
- if (TCL_OK != ParseTokens(p, length, /* mask */ 0, flags, &parse)) {
+ if (TCL_OK != ParseTokens(interp, p, length, /* mask */ 0, flags, parsePtr)) {
/*
* There was a parse error. Save the error message for possible
* reporting later.
@@ -1956,18 +1954,19 @@ Tcl_SubstObj(
*/
do {
- parse.numTokens = 0;
- parse.tokensAvailable = NUM_STATIC_TOKENS;
- parse.end = parse.term;
- parse.incomplete = 0;
- parse.errorType = TCL_PARSE_SUCCESS;
- } while (TCL_OK != ParseTokens(p, parse.end - p, 0, flags, &parse));
+ parsePtr->numTokens = 0;
+ parsePtr->tokensAvailable = NUM_STATIC_TOKENS;
+ parsePtr->end = parsePtr->term;
+ parsePtr->incomplete = 0;
+ parsePtr->errorType = TCL_PARSE_SUCCESS;
+ } while (TCL_OK !=
+ ParseTokens(interp, p, parsePtr->end - p, 0, flags, parsePtr));
/*
* The good parse will have to be followed by {, (, or [.
*/
- switch (*parse.term) {
+ switch (*(parsePtr->term)) {
case '{':
/*
* Parse error was a missing } in a ${varname} variable
@@ -1984,7 +1983,7 @@ Tcl_SubstObj(
* array variable substitution at the toplevel.
*/
- if (*(parse.term - 1) == '$') {
+ if (*(parsePtr->term - 1) == '$') {
/*
* Special case where removing the array index left us with
* just a dollar sign (array variable with name the empty
@@ -2003,7 +2002,7 @@ Tcl_SubstObj(
*/
Tcl_Token *varTokenPtr =
- parse.tokenPtr + parse.numTokens - 2;
+ parsePtr->tokenPtr + parsePtr->numTokens - 2;
if (varTokenPtr->type != TCL_TOKEN_VARIABLE) {
Tcl_Panic("Tcl_SubstObj: programming error");
@@ -2011,7 +2010,7 @@ Tcl_SubstObj(
if (varTokenPtr[1].type != TCL_TOKEN_TEXT) {
Tcl_Panic("Tcl_SubstObj: programming error");
}
- parse.numTokens -= 2;
+ parsePtr->numTokens -= 2;
}
break;
case '[':
@@ -2020,9 +2019,9 @@ Tcl_SubstObj(
* substitution.
*/
- parse.end = p + length;
- p = parse.term + 1;
- length = parse.end - p;
+ parsePtr->end = p + length;
+ p = parsePtr->term + 1;
+ length = parsePtr->end - p;
if (length == 0) {
/*
* No commands, just an unmatched [. As in previous cases,
@@ -2037,15 +2036,16 @@ Tcl_SubstObj(
*/
Tcl_Token *tokenPtr;
- Tcl_Parse nested;
- CONST char *lastTerm = parse.term;
+ CONST char *lastTerm = parsePtr->term;
+ Tcl_Parse *nestedPtr =
+ (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse));
while (TCL_OK ==
- Tcl_ParseCommand(NULL, p, length, 0, &nested)) {
- Tcl_FreeParse(&nested);
- p = nested.term + (nested.term < nested.end);
- length = nested.end - p;
- if ((length == 0) && (nested.term == nested.end)) {
+ Tcl_ParseCommand(NULL, p, length, 0, nestedPtr)) {
+ Tcl_FreeParse(nestedPtr);
+ p = nestedPtr->term + (nestedPtr->term < nestedPtr->end);
+ length = nestedPtr->end - p;
+ if ((length == 0) && (nestedPtr->term == nestedPtr->end)) {
/*
* If we run out of string, blame the missing close
* bracket on the last command, and do not evaluate it
@@ -2054,10 +2054,11 @@ Tcl_SubstObj(
break;
}
- lastTerm = nested.term;
+ lastTerm = nestedPtr->term;
}
+ TclStackFree(interp, nestedPtr);
- if (lastTerm == parse.term) {
+ if (lastTerm == parsePtr->term) {
/*
* Parse error in first command. No commands to subst, add
* no more tokens.
@@ -2070,15 +2071,15 @@ Tcl_SubstObj(
* got parsed.
*/
- if (parse.numTokens == parse.tokensAvailable) {
- TclExpandTokenArray(&parse);
+ if (parsePtr->numTokens == parsePtr->tokensAvailable) {
+ TclExpandTokenArray(parsePtr);
}
- tokenPtr = &parse.tokenPtr[parse.numTokens];
- tokenPtr->start = parse.term;
+ tokenPtr = &(parsePtr->tokenPtr[parsePtr->numTokens]);
+ tokenPtr->start = parsePtr->term;
tokenPtr->numComponents = 0;
tokenPtr->type = TCL_TOKEN_COMMAND;
tokenPtr->size = lastTerm - tokenPtr->start + 1;
- parse.numTokens++;
+ parsePtr->numTokens++;
}
break;
@@ -2091,12 +2092,13 @@ Tcl_SubstObj(
* Next, substitute the parsed tokens just as in normal Tcl evaluation.
*/
- endTokenPtr = parse.tokenPtr + parse.numTokens;
- tokensLeft = parse.numTokens;
+ endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens;
+ tokensLeft = parsePtr->numTokens;
code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft,
&tokensLeft, 1);
if (code == TCL_OK) {
- Tcl_FreeParse(&parse);
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
if (errMsg != NULL) {
Tcl_SetObjResult(interp, errMsg);
Tcl_DecrRefCount(errMsg);
@@ -2109,7 +2111,8 @@ Tcl_SubstObj(
while (1) {
switch (code) {
case TCL_ERROR:
- Tcl_FreeParse(&parse);
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
Tcl_DecrRefCount(result);
if (errMsg != NULL) {
Tcl_DecrRefCount(errMsg);
@@ -2122,7 +2125,8 @@ Tcl_SubstObj(
}
if (tokensLeft == 0) {
- Tcl_FreeParse(&parse);
+ Tcl_FreeParse(parsePtr);
+ TclStackFree(interp, parsePtr);
if (errMsg != NULL) {
if (code != TCL_BREAK) {
Tcl_DecrRefCount(result);