diff options
author | andreas_kupries <andreas_kupries@noemail.net> | 2009-08-25 20:59:08 (GMT) |
---|---|---|
committer | andreas_kupries <andreas_kupries@noemail.net> | 2009-08-25 20:59:08 (GMT) |
commit | d496db72751fb3d1b71d9d1ae7455e932c9b37c4 (patch) | |
tree | 4a737e378aa3ed2c71519eae3320f02faabfcc2c /generic/tclBasic.c | |
parent | 849257ecb827d7627fbfec74b9cd4454051c6726 (diff) | |
download | tcl-d496db72751fb3d1b71d9d1ae7455e932c9b37c4.zip tcl-d496db72751fb3d1b71d9d1ae7455e932c9b37c4.tar.gz tcl-d496db72751fb3d1b71d9d1ae7455e932c9b37c4.tar.bz2 |
* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard,
EvalTokensStandard, Tcl_EvalEx, EvalEx, TclAdvanceContinuations,
TclEvalObjEx):
* generic/tclCmdMZ.c (Tcl_SwitchObjCmd, ListLines):
* generic/tclCompCmds.c (*):
* generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv,
TclFreeCompileEnv, TclCompileScript):
* generic/tclCompile.h (CompileEnv):
* generic/tclInt.h (ContLineLoc, Interp):
* generic/tclObj.c (ThreadSpecificData, ContLineLocFree,
TclThreadFinalizeObjects, TclInitObjSubsystem,
TclContinuationsEnter, TclContinuationsEnterDerived,
TclContinuationsCopy, TclContinuationsGet, TclFreeObj):
* generic/tclProc.c (TclCreateProc):
* generic/tclVar.c (TclPtrSetVar):
* tests/info.test (info-30.0-22):
Extended parser, compiler, and execution with code and attendant
data structures tracking the positions of continuation lines which
are not visible in script's, to properly account for them while
counting lines for #280, during direct and compiled execution.
FossilOrigin-Name: 9fa7a1ee78b8d615101ff67e210dde680136589f
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r-- | generic/tclBasic.c | 300 |
1 files changed, 278 insertions, 22 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 6afe56a..715af1b 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.75.2.36 2009/07/23 15:23:54 das Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.75.2.37 2009/08/25 20:59:10 andreas_kupries Exp $ */ #include "tclInt.h" @@ -43,13 +43,15 @@ static int StringTraceProc _ANSI_ARGS_((ClientData clientData, static void StringTraceDeleteProc _ANSI_ARGS_((ClientData clientData)); #ifdef TCL_TIP280 -/* TIP #280 - Modified token based evulation, with line information */ +/* TIP #280 - Modified token based evaluation, with line information */ static int EvalEx _ANSI_ARGS_((Tcl_Interp *interp, CONST char *script, - int numBytes, int flags, int line)); + int numBytes, int flags, int line, + int* clNextOuter, CONST char* outerScript)); static int EvalTokensStandard _ANSI_ARGS_((Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count, int line)); + int count, int line, + int* clNextOuter, CONST char* outerScript)); #endif #ifdef USE_DTRACE @@ -365,6 +367,7 @@ Tcl_CreateInterp() Tcl_InitHashTable(iPtr->lineBCPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLAPtr, TCL_ONE_WORD_KEYS); Tcl_InitHashTable(iPtr->lineLABCPtr, TCL_ONE_WORD_KEYS); + iPtr->scriptCLLocPtr = NULL; #endif iPtr->activeVarTracePtr = NULL; @@ -3544,11 +3547,11 @@ Tcl_EvalTokensStandard(interp, tokenPtr, count) * Must be at least 1. */ { #ifdef TCL_TIP280 - return EvalTokensStandard (interp, tokenPtr, count, 1); + return EvalTokensStandard (interp, tokenPtr, count, 1, NULL, NULL); } static int -EvalTokensStandard(interp, tokenPtr, count, line) +EvalTokensStandard(interp, tokenPtr, count, line, clNextOuter, outerScript) Tcl_Interp *interp; /* Interpreter in which to lookup * variables, execute nested commands, * and report errors. */ @@ -3557,6 +3560,22 @@ EvalTokensStandard(interp, tokenPtr, count, line) int count; /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ int line; /* The line the script starts on. */ + int* clNextOuter; /* Information about an outer context for */ + CONST char* outerScript; /* continuation line data. This is set by + * EvalEx() to properly handle [...]-nested + * commands. The 'outerScript' refers to the + * most-outer script containing the embedded + * command, which is refered to by 'script'. The + * 'clNextOuter' refers to the current entry in + * the table of continuation lines in this + * "master script", and the character offsets are + * relative to the 'outerScript' as well. + * + * If outerScript == script, then this call is for + * words in the outer-most script/command. See + * Tcl_EvalEx() and TclEvalObjEx() for the places + * generating arguments for which this is true. + */ { #endif Tcl_Obj *resultPtr, *indexPtr, *valuePtr; @@ -3570,6 +3589,13 @@ EvalTokensStandard(interp, tokenPtr, count, line) char *varName, *index; CONST char *p = NULL; /* Initialized to avoid compiler warning. */ int length, code; +#ifdef TCL_TIP280 +#define NUM_STATIC_POS 20 + int isLiteral, maxNumCL, numCL, i, adjust; + int* clPosition; + Interp* iPtr = (Interp*) interp; + int inFile = iPtr->evalFlags & TCL_EVAL_FILE; +#endif /* * The only tricky thing about this procedure is that it attempts to @@ -3581,6 +3607,32 @@ EvalTokensStandard(interp, tokenPtr, count, line) code = TCL_OK; resultPtr = NULL; Tcl_ResetResult(interp); +#ifdef TCL_TIP280 + /* + * For the handling of continuation lines in literals we first check if + * this is actually a literal. For if not we can forego the additional + * processing. Otherwise we pre-allocate a small table to store the + * locations of all continuation lines we find in this literal, if + * any. The table is extended if needed. + */ + + numCL = 0; + maxNumCL = 0; + isLiteral = 1; + for (i=0 ; i < count; i++) { + if ((tokenPtr[i].type != TCL_TOKEN_TEXT) && + (tokenPtr[i].type != TCL_TOKEN_BS)) { + isLiteral = 0; + break; + } + } + + if (isLiteral) { + maxNumCL = NUM_STATIC_POS; + clPosition = (int*) ckalloc (maxNumCL*sizeof(int)); + } + adjust = 0; +#endif for ( ; count > 0; count--, tokenPtr++) { valuePtr = NULL; @@ -3600,6 +3652,43 @@ EvalTokensStandard(interp, tokenPtr, count, line) length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL, buffer); p = buffer; +#ifdef TCL_TIP280 + /* + * If the backslash sequence we found is in a literal, and + * represented a continuation line, we compute and store its + * location (as char offset to the beginning of the _result_ + * script). We may have to extend the table of locations. + * + * Note that the continuation line information is relevant + * even if the word we are processing is not a literal, as it + * can affect nested commands. See the branch for + * TCL_TOKEN_COMMAND below, where the adjustment we are + * tracking here is taken into account. The good thing is that + * we do not need a table of everything, just the number of + * lines we have to add as correction. + */ + + if ((length == 1) && (buffer[0] == ' ') && + (tokenPtr->start[1] == '\n')) { + if (isLiteral) { + int clPos; + if (resultPtr == 0) { + clPos = 0; + } else { + Tcl_GetStringFromObj(resultPtr, &clPos); + } + + if (numCL >= maxNumCL) { + maxNumCL *= 2; + clPosition = (int*) ckrealloc ((char*)clPosition, + maxNumCL*sizeof(int)); + } + clPosition[numCL] = clPos; + numCL ++; + } + adjust ++; + } +#endif break; case TCL_TOKEN_COMMAND: { @@ -3612,8 +3701,19 @@ EvalTokensStandard(interp, tokenPtr, count, line) tokenPtr->start+1, tokenPtr->size-2, 0); #else /* TIP #280: Transfer line information to nested command */ + TclAdvanceContinuations (&line, &clNextOuter, + tokenPtr->start - outerScript); code = EvalEx(interp, - tokenPtr->start+1, tokenPtr->size-2, 0, line); + tokenPtr->start+1, tokenPtr->size-2, 0, + line + adjust, clNextOuter, outerScript); + + /* + * Restore flag reset by the nested eval for future + * bracketed commands and their CmdFrame setup + */ + if (inFile) { + iPtr->evalFlags |= TCL_EVAL_FILE; + } #endif } iPtr->numLevels--; @@ -3635,7 +3735,7 @@ EvalTokensStandard(interp, tokenPtr, count, line) #else /* TIP #280: Transfer line information to nested command */ code = EvalTokensStandard(interp, tokenPtr+2, - tokenPtr->numComponents - 1, line); + tokenPtr->numComponents - 1, line, NULL, NULL); #endif if (code != TCL_OK) { goto done; @@ -3706,6 +3806,28 @@ EvalTokensStandard(interp, tokenPtr, count, line) } if (resultPtr != NULL) { Tcl_SetObjResult(interp, resultPtr); +#ifdef TCL_TIP280 + /* + * If the code found continuation lines (which implies that this word + * is a literal), then we store the accumulated table of locations in + * the thread-global data structure for the bytecode compiler to find + * later, assuming that the literal is a script which will be + * compiled. + */ + + if (numCL) { + TclContinuationsEnter(resultPtr, numCL, clPosition); + } + + /* + * Release the temp table we used to collect the locations of + * continuation lines, if any. + */ + + if (maxNumCL) { + ckfree ((char*) clPosition); + } +#endif } else { code = TCL_ERROR; } @@ -3805,11 +3927,11 @@ Tcl_EvalEx(interp, script, numBytes, flags) * supported. */ { #ifdef TCL_TIP280 - return EvalEx (interp, script, numBytes, flags, 1); + return EvalEx (interp, script, numBytes, flags, 1, NULL, script); } static int -EvalEx(interp, script, numBytes, flags, line) +EvalEx(interp, script, numBytes, flags, line, clNextOuter, outerScript) Tcl_Interp *interp; /* Interpreter in which to evaluate the * script. Also used for error reporting. */ CONST char *script; /* First character of script to evaluate. */ @@ -3821,6 +3943,23 @@ EvalEx(interp, script, numBytes, flags, line) * TCL_EVAL_GLOBAL is currently * supported. */ int line; /* The line the script starts on. */ + int* clNextOuter; /* Information about an outer context for */ + CONST char* outerScript; /* continuation line data. This is set only in + * EvalTokensStandard(), to properly handle + * [...]-nested commands. The 'outerScript' + * refers to the most-outer script containing the + * embedded command, which is refered to by + * 'script'. The 'clNextOuter' refers to the + * current entry in the table of continuation + * lines in this "master script", and the + * character offsets are relative to the + * 'outerScript' as well. + * + * If outerScript == script, then this call is + * for the outer-most script/command. See + * Tcl_EvalEx() and TclEvalObjEx() for places + * generating arguments for which this is true. + */ { #endif Interp *iPtr = (Interp *) interp; @@ -3846,6 +3985,24 @@ EvalEx(interp, script, numBytes, flags, line) #ifdef TCL_TIP280 /* TIP #280 Structures for tracking of command locations. */ CmdFrame eeFrame; + + /* + * Pointer for the tracking of invisible continuation lines. Initialized + * only if the caller gave us a table of locations to track, via + * scriptCLLocPtr. It always refers to the table entry holding the + * location of the next invisible continuation line to look for, while + * parsing the script. + */ + + int* clNext = NULL; + + if (iPtr->scriptCLLocPtr) { + if (clNextOuter) { + clNext = clNextOuter; + } else { + clNext = &iPtr->scriptCLLocPtr->loc[0]; + } + } #endif if (numBytes < 0) { @@ -3914,7 +4071,7 @@ EvalEx(interp, script, numBytes, flags, line) } else { /* Set up for plain eval */ - eeFrame.type = TCL_LOCATION_EVAL; + eeFrame.type = TCL_LOCATION_EVAL; eeFrame.data.eval.path = NULL; } @@ -3951,21 +4108,26 @@ EvalEx(interp, script, numBytes, flags, line) /* * TIP #280 Track lines. The parser may have skipped text till it * found the command we are now at. We have count the lines in this - * block. + * block, and do not forget invisible continuation lines. */ - TclAdvanceLines (&line, p, parse.commandStart); + TclAdvanceLines (&line, p, parse.commandStart); + TclAdvanceContinuations (&line, &clNext, + parse.commandStart - outerScript); #endif if (parse.numWords > 0) { #ifdef TCL_TIP280 /* * TIP #280. Track lines within the words of the current - * command. + * command. We use a separate pointer into the table of + * continuation line locations to not lose our position for the + * per-command parsing. */ - int wordLine = line; - CONST char* wordStart = parse.commandStart; + int wordLine = line; + CONST char* wordStart = parse.commandStart; + int* wordCLNext = clNext; #endif /* @@ -4000,10 +4162,12 @@ EvalEx(interp, script, numBytes, flags, line) * (source vs. eval). */ - TclAdvanceLines (&wordLine, wordStart, tokenPtr->start); + TclAdvanceLines (&wordLine, wordStart, tokenPtr->start); + TclAdvanceContinuations (&wordLine, &wordCLNext, + tokenPtr->start - outerScript); wordStart = tokenPtr->start; - eeFrame.line [objectsUsed] = (TclWordKnownAtCompileTime (tokenPtr) + eeFrame.line [objectsUsed] = (TclWordKnownAtCompileTime (tokenPtr) ? wordLine : -1); @@ -4012,7 +4176,8 @@ EvalEx(interp, script, numBytes, flags, line) } code = EvalTokensStandard(interp, tokenPtr+1, - tokenPtr->numComponents, wordLine); + tokenPtr->numComponents, wordLine, + wordCLNext, outerScript); iPtr->evalFlags = 0; #endif @@ -4020,6 +4185,12 @@ EvalEx(interp, script, numBytes, flags, line) if (code == TCL_OK) { objv[objectsUsed] = Tcl_GetObjResult(interp); Tcl_IncrRefCount(objv[objectsUsed]); +#ifdef TCL_TIP280 + if (wordCLNext) { + TclContinuationsEnterDerived (objv[objectsUsed], + wordStart - outerScript, wordCLNext); + } +#endif } else { goto error; } @@ -4314,6 +4485,53 @@ TclAdvanceLines (line,start,end) /* *---------------------------------------------------------------------- + * + * TclAdvanceContinuations -- + * + * This procedure is a helper which counts the number of continuation + * lines (CL) in a block of text using a table of CL locations and + * advances an external counter, and the pointer into the table. + * + * Results: + * None. + * + * Side effects: + * The specified counter is advanced per the number of continuation lines + * found. + * + * TIP #280 + *---------------------------------------------------------------------- + */ + +void +TclAdvanceContinuations (line,clNextPtrPtr,loc) + int* line; + int** clNextPtrPtr; + int loc; +{ + /* + * Track the invisible continuation lines embedded in a script, if + * any. Here they are just spaces (already). They were removed by + * EvalTokensStandard() via Tcl_UtfBackslash(). + * + * *clNextPtrPtr <=> We have continuation lines to track. + * **clNextPtrPtr >= 0 <=> We are not beyond the last possible location. + * loc >= **clNextPtrPtr <=> We stepped beyond the current cont. line. + */ + + while (*clNextPtrPtr && (**clNextPtrPtr >= 0) && (loc >= **clNextPtrPtr)) { + /* + * We just stepped over an invisible continuation line. Adjust the + * line counter and step to the table entry holding the location of + * the next continuation line to track. + */ + (*line) ++; + (*clNextPtrPtr) ++; + } +} + +/* + *---------------------------------------------------------------------- * Note: The whole data structure access for argument location tracking is * hidden behind these three functions. The only parts open are the lineLAPtr * field in the Interp structure. The CFWord definition is internal to here. @@ -4644,7 +4862,7 @@ TclArgumentGet(interp,obj,cfPtrPtr,wordPtr) CFWordBC* cfwPtr = (CFWordBC*) Tcl_GetHashValue (hPtr); framePtr = cfwPtr->framePtr; - framePtr->data.tebc.pc = ((ByteCode*) + framePtr->data.tebc.pc = (char*) ((ByteCode*) framePtr->data.tebc.codePtr)->codeStart + cfwPtr->pc; *cfPtrPtr = cfwPtr->framePtr; *wordPtr = cfwPtr->word; @@ -4912,6 +5130,34 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) * code in the bytecode compiler. */ + /* + * Now we check if we have data about invisible continuation lines + * for the script, and make it available to the direct script + * parser and evaluator we are about to call, if so. + * + * It may be possible that the script Tcl_Obj* can be free'd while + * the evaluator is using it, leading to the release of the + * associated ContLineLoc structure as well. To ensure that the + * latter doesn't happen we set a lock on it. We release this lock + * later in this function, after the evaluator is done. The + * relevant "lineCLPtr" hashtable is managed in the file + * "tclObj.c". + * + * Another important action is to save (and later restore) the + * continuation line information of the caller, in case we are + * executing nested commands in the eval/direct path. + */ + + ContLineLoc* saveCLLocPtr = iPtr->scriptCLLocPtr; + ContLineLoc* clLocPtr = TclContinuationsGet (objPtr); + + if (clLocPtr) { + iPtr->scriptCLLocPtr = clLocPtr; + Tcl_Preserve (iPtr->scriptCLLocPtr); + } else { + iPtr->scriptCLLocPtr = NULL; + } + if (invoker == NULL) { /* No context, force opening of our own */ script = Tcl_GetStringFromObj(objPtr, &numSrcBytes); @@ -4956,7 +5202,8 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) iPtr->invokeCmdFramePtr = &ctx; iPtr->evalFlags |= TCL_EVAL_CTX; - result = EvalEx(interp, script, numSrcBytes, flags, ctx.line [word]); + result = EvalEx(interp, script, numSrcBytes, flags, + ctx.line [word], NULL, script); if (pc) { /* Death of SrcInfo reference */ @@ -4964,6 +5211,16 @@ TclEvalObjEx(interp, objPtr, flags, invoker, word) } } } + + /* + * Now release the lock on the continuation line information, if + * any, and restore the caller's settings. + */ + + if (iPtr->scriptCLLocPtr) { + Tcl_Release (iPtr->scriptCLLocPtr); + } + iPtr->scriptCLLocPtr = saveCLLocPtr; #endif } } else { @@ -6535,4 +6792,3 @@ TCL_DTRACE_DEBUG_LOG() * fill-column: 78 * End: */ - |