diff options
author | dgp <dgp@users.sourceforge.net> | 2007-06-21 18:41:16 (GMT) |
---|---|---|
committer | dgp <dgp@users.sourceforge.net> | 2007-06-21 18:41:16 (GMT) |
commit | abe71b0d5a315b3f7fa348e2318547e5180ef089 (patch) | |
tree | 7de5b3b13fb94070c2bc1d7014d0e9ec3a4fa5bd /generic | |
parent | 1cf3fb4fff5a0437a76e658e7ed16ef5928cc974 (diff) | |
download | tcl-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:
Diffstat (limited to 'generic')
-rw-r--r-- | generic/tclBasic.c | 55 | ||||
-rw-r--r-- | generic/tclCompExpr.c | 173 | ||||
-rw-r--r-- | generic/tclCompile.c | 66 | ||||
-rw-r--r-- | generic/tclParse.c | 154 |
4 files changed, 236 insertions, 212 deletions
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); |