diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclBasic.c | 162 | ||||
| -rw-r--r-- | generic/tclCmdMZ.c | 26 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 115 | ||||
| -rw-r--r-- | generic/tclCompile.c | 163 | ||||
| -rw-r--r-- | generic/tclCompile.h | 12 | ||||
| -rw-r--r-- | generic/tclInt.h | 57 | ||||
| -rw-r--r-- | generic/tclObj.c | 390 | ||||
| -rw-r--r-- | generic/tclParse.c | 130 | ||||
| -rw-r--r-- | generic/tclProc.c | 14 | ||||
| -rw-r--r-- | generic/tclVar.c | 10 |
10 files changed, 982 insertions, 97 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c index d7cbe39..77e9a31 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.295.2.12 2009/07/23 15:23:50 das Exp $ + * RCS: @(#) $Id: tclBasic.c,v 1.295.2.13 2009/08/25 21:01:05 andreas_kupries Exp $ */ #include "tclInt.h" @@ -450,6 +450,7 @@ Tcl_CreateInterp(void) 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; iPtr->activeVarTracePtr = NULL; @@ -3954,7 +3955,8 @@ Tcl_EvalTokensStandard( int count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { - return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1); + return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, + NULL, NULL); } /* @@ -4038,7 +4040,7 @@ Tcl_EvalEx( * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ { - return TclEvalEx(interp, script, numBytes, flags, 1); + return TclEvalEx(interp, script, numBytes, flags, 1, NULL, script); } int @@ -4052,7 +4054,24 @@ TclEvalEx( int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ - int line) /* The line the script starts on. */ + 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. + */ { Interp *iPtr = (Interp *) interp; const char *p, *next; @@ -4080,6 +4099,23 @@ TclEvalEx( int *linesStack = (int *) TclStackAlloc(interp, minObjs * sizeof(int)); /* TIP #280 Structures for tracking of command * locations. */ + /* + * 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]; + } + } if (numBytes < 0) { numBytes = strlen(script); @@ -4105,12 +4141,12 @@ TclEvalEx( /* * TIP #280 Initialize tracking. Do not push on the frame stack yet. * - * We may cont. counting based on a specific context (CTX), or open a new - * context, either for a sourced script, or 'eval'. For sourced files we - * always have a path object, even if nothing was specified in the interp - * itself. That makes code using it simpler as NULL checks can be left - * out. Sourced file without path in the 'scriptFile' is possible during - * Tcl initialization. + * We may continue counting based on a specific context (CTX), or open a + * new context, either for a sourced script, or 'eval'. For sourced files + * we always have a path object, even if nothing was specified in the + * interp itself. That makes code using it simpler as NULL checks can be + * left out. Sourced file without path in the 'scriptFile' is possible + * during Tcl initialization. */ if (iPtr->evalFlags & TCL_EVAL_CTX) { @@ -4175,19 +4211,25 @@ TclEvalEx( /* * TIP #280 Track lines. The parser may have skipped text till it * found the command we are now at. We have to count the lines in this - * block. + * block, and do not forget invisible continuation lines. */ TclAdvanceLines(&line, p, parsePtr->commandStart); + TclAdvanceContinuations (&line, &clNext, + parsePtr->commandStart - outerScript); gotParse = 1; if (parsePtr->numWords > 0) { /* - * TIP #280. Track lines within the words of the current command. + * TIP #280. Track lines within the words of the current + * 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 = parsePtr->commandStart; + int* wordCLNext = clNext; /* * Generate an array of objects for the words of the command. @@ -4218,6 +4260,8 @@ TclEvalEx( */ TclAdvanceLines(&wordLine, wordStart, tokenPtr->start); + TclAdvanceContinuations (&wordLine, &wordCLNext, + tokenPtr->start - outerScript); wordStart = tokenPtr->start; lines[objectsUsed] = TclWordKnownAtCompileTime(tokenPtr, NULL) @@ -4228,7 +4272,8 @@ TclEvalEx( } code = TclSubstTokens(interp, tokenPtr+1, - tokenPtr->numComponents, NULL, wordLine); + tokenPtr->numComponents, NULL, wordLine, + wordCLNext, outerScript); iPtr->evalFlags = 0; @@ -4260,6 +4305,11 @@ TclEvalEx( expand[objectsUsed] = 0; objectsNeeded++; } + + if (wordCLNext) { + TclContinuationsEnterDerived (objv[objectsUsed], + wordStart - outerScript, wordCLNext); + } } /* for loop */ if (expandRequested) { /* @@ -4487,6 +4537,53 @@ TclAdvanceLines( /* *---------------------------------------------------------------------- + * + * 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. @@ -5044,6 +5141,33 @@ TclEvalObjEx( * 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. @@ -5101,7 +5225,7 @@ TclEvalObjEx( iPtr->evalFlags |= TCL_EVAL_CTX; result = TclEvalEx(interp, script, numSrcBytes, flags, - ctxPtr->line[word]); + ctxPtr->line[word], NULL, script); if (pc) { /* @@ -5112,6 +5236,16 @@ TclEvalObjEx( } } TclStackFree(interp, ctxPtr); + + /* + * 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; } } else { /* diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c index aa12480..1ff2138 100644 --- a/generic/tclCmdMZ.c +++ b/generic/tclCmdMZ.c @@ -15,7 +15,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCmdMZ.c,v 1.163.2.4 2009/07/20 09:26:16 dkf Exp $ + * RCS: @(#) $Id: tclCmdMZ.c,v 1.163.2.5 2009/08/25 21:01:05 andreas_kupries Exp $ */ #include "tclInt.h" @@ -3853,7 +3853,7 @@ Tcl_SwitchObjCmd( ctxPtr->line = (int *) ckalloc(objc * sizeof(int)); ctxPtr->nline = objc; - TclListLines(TclGetString(blist), bline, objc, ctxPtr->line); + TclListLines(blist, bline, objc, ctxPtr->line, objv); } else { /* * This is either a dynamic code word, when all elements are @@ -3891,7 +3891,7 @@ Tcl_SwitchObjCmd( * TIP #280: Make invoking context available to switch branch. */ - result = TclEvalObjEx(interp, objv[j], 0, ctxPtr, j); + result = TclEvalObjEx(interp, objv[j], 0, ctxPtr, splitObjs ? j : bidx+j); if (splitObjs) { ckfree((char *) ctxPtr->line); if (pc && (ctxPtr->type == TCL_LOCATION_SOURCE)) { @@ -4094,21 +4094,33 @@ Tcl_WhileObjCmd( void TclListLines( - CONST char *listStr, /* Pointer to string with list structure. - * Assumed to be valid. Assumed to contain n - * elements. */ + Tcl_Obj* listObj, /* Pointer to obj holding a string with list + * structure. Assumed to be valid. Assumed to + * contain n elements. + */ int line, /* Line the list as a whole starts on. */ int n, /* #elements in lines */ - int *lines) /* Array of line numbers, to fill. */ + int *lines, /* Array of line numbers, to fill. */ + Tcl_Obj* const* elems) /* The list elems as Tcl_Obj*, in need of + * derived continuation data */ { + CONST char* listStr = Tcl_GetString (listObj); + CONST char* listHead = listStr; int i, length = strlen(listStr); CONST char *element = NULL, *next = NULL; + ContLineLoc* clLocPtr = TclContinuationsGet(listObj); + int* clNext = (clLocPtr ? &clLocPtr->loc[0] : NULL); for (i = 0; i < n; i++) { TclFindElement(NULL, listStr, length, &element, &next, NULL, NULL); TclAdvanceLines(&line, listStr, element); /* Leading whitespace */ + TclAdvanceContinuations (&line, &clNext, element - listHead); + if (elems && clNext) { + TclContinuationsEnterDerived (elems[i], element - listHead, + clNext); + } lines[i] = line; length -= (next - listStr); TclAdvanceLines(&line, element, next); diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 6a71666..d01964d 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -12,7 +12,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompCmds.c,v 1.143.2.1 2008/05/07 10:39:38 dkf Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.143.2.2 2009/08/25 21:01:05 andreas_kupries Exp $ */ #include "tclInt.h" @@ -31,7 +31,8 @@ TclEmitPush(TclRegisterNewLiteral((envPtr), (tokenPtr)[1].start, \ (tokenPtr)[1].size), (envPtr)); \ } else { \ - envPtr->line = mapPtr->loc[eclIndex].line[word]; \ + envPtr->line = mapPtr->loc[eclIndex].line[word]; \ + envPtr->clNext = mapPtr->loc[eclIndex].next[word]; \ TclCompileTokens((interp), (tokenPtr)+1, (tokenPtr)->numComponents, \ (envPtr)); \ } @@ -49,6 +50,10 @@ ExtCmdLoc *mapPtr = envPtr->extCmdMapPtr; \ int eclIndex = mapPtr->nuloc - 1 +#define SetLineInformation(word) \ + envPtr->line = mapPtr->loc [eclIndex].line [(word)]; \ + envPtr->clNext = mapPtr->loc [eclIndex].next [(word)] + /* * Convenience macro for use when compiling bodies of commands. The ANSI C * "prototype" for this macro is: @@ -152,7 +157,8 @@ static void PrintJumptableInfo(ClientData clientData, static int PushVarName(Tcl_Interp *interp, Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags, int *localIndexPtr, - int *simpleVarNamePtr, int *isScalarPtr, int line); + int *simpleVarNamePtr, int *isScalarPtr, + int line, int* clNext); static int CompileAssociativeBinaryOpCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr, const char *identity, int instruction, CompileEnv *envPtr); @@ -169,6 +175,11 @@ static void CompileReturnInternal(CompileEnv *envPtr, unsigned char op, int code, int level, Tcl_Obj *returnOpts); +#define PushVarNameWord(i,v,e,f,l,s,sc,word) \ + PushVarName (i,v,e,f,l,s,sc, \ + mapPtr->loc [eclIndex].line [(word)], \ + mapPtr->loc [eclIndex].next [(word)]) + /* * Flags bits used by PushVarName. */ @@ -259,9 +270,8 @@ TclCompileAppendCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, - &localIndex, &simpleVarName, &isScalar, - mapPtr->loc[eclIndex].line[1]); + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + &localIndex, &simpleVarName, &isScalar, 1); /* * We are doing an assignment, otherwise TclCompileSetCmd was called, so @@ -449,7 +459,7 @@ TclCompileCatchCmd( * range so that errors in the substitution are not catched [Bug 219184] */ - envPtr->line = mapPtr->loc[eclIndex].line[1]; + SetLineInformation (1); if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) { ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, cmdTokenPtr, interp); @@ -921,7 +931,7 @@ TclCompileDictForCmd( * Compile the loop body itself. It should be stack-neutral. */ - envPtr->line = mapPtr->loc[eclIndex].line[4]; + SetLineInformation (4); CompileBody(envPtr, bodyTokenPtr, interp); TclEmitOpcode( INST_POP, envPtr); @@ -1447,7 +1457,7 @@ TclCompileForCmd( * Inline compile the initial command. */ - envPtr->line = mapPtr->loc[eclIndex].line[1]; + SetLineInformation (1); CompileBody(envPtr, startTokenPtr, interp); TclEmitOpcode(INST_POP, envPtr); @@ -1470,7 +1480,7 @@ TclCompileForCmd( */ bodyCodeOffset = ExceptionRangeStarts(envPtr, bodyRange); - envPtr->line = mapPtr->loc[eclIndex].line[4]; + SetLineInformation (4); CompileBody(envPtr, bodyTokenPtr, interp); ExceptionRangeEnds(envPtr, bodyRange); envPtr->currStackDepth = savedStackDepth + 1; @@ -1482,7 +1492,7 @@ TclCompileForCmd( envPtr->currStackDepth = savedStackDepth; nextCodeOffset = ExceptionRangeStarts(envPtr, nextRange); - envPtr->line = mapPtr->loc[eclIndex].line[3]; + SetLineInformation (3); CompileBody(envPtr, nextTokenPtr, interp); ExceptionRangeEnds(envPtr, nextRange); envPtr->currStackDepth = savedStackDepth + 1; @@ -1503,7 +1513,7 @@ TclCompileForCmd( testCodeOffset += 3; } - envPtr->line = mapPtr->loc[eclIndex].line[2]; + SetLineInformation (2); envPtr->currStackDepth = savedStackDepth; TclCompileExprWords(interp, testTokenPtr, 1, envPtr); envPtr->currStackDepth = savedStackDepth + 1; @@ -1753,7 +1763,7 @@ TclCompileForeachCmd( i < numWords-1; i++, tokenPtr = TokenAfter(tokenPtr)) { if ((i%2 == 0) && (i > 0)) { - envPtr->line = mapPtr->loc[eclIndex].line[i]; + SetLineInformation (i); CompileTokens(envPtr, tokenPtr, interp); tempVar = (firstValueTemp + loopIndex); if (tempVar <= 255) { @@ -1785,7 +1795,7 @@ TclCompileForeachCmd( * Inline compile the loop body. */ - envPtr->line = mapPtr->loc[eclIndex].line[bodyIndex]; + SetLineInformation (bodyIndex); ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, bodyTokenPtr, interp); ExceptionRangeEnds(envPtr, range); @@ -2124,7 +2134,7 @@ TclCompileIfCmd( compileScripts = 0; } } else { - envPtr->line = mapPtr->loc[eclIndex].line[wordIdx]; + SetLineInformation (wordIdx); Tcl_ResetResult(interp); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); if (jumpFalseFixupArray.next >= jumpFalseFixupArray.end) { @@ -2166,7 +2176,7 @@ TclCompileIfCmd( */ if (compileScripts) { - envPtr->line = mapPtr->loc[eclIndex].line[wordIdx]; + SetLineInformation (wordIdx); envPtr->currStackDepth = savedStackDepth; CompileBody(envPtr, tokenPtr, interp); } @@ -2254,7 +2264,7 @@ TclCompileIfCmd( * Compile the else command body. */ - envPtr->line = mapPtr->loc[eclIndex].line[wordIdx]; + SetLineInformation (wordIdx); CompileBody(envPtr, tokenPtr, interp); } @@ -2356,9 +2366,8 @@ TclCompileIncrCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR, - &localIndex, &simpleVarName, &isScalar, - mapPtr->loc[eclIndex].line[1]); + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR, + &localIndex, &simpleVarName, &isScalar, 1); /* * If an increment is given, push it, but see first if it's a small @@ -2384,7 +2393,7 @@ TclCompileIncrCmd( PushLiteral(envPtr, word, numBytes); } } else { - envPtr->line = mapPtr->loc[eclIndex].line[2]; + SetLineInformation (2); CompileTokens(envPtr, incrTokenPtr, interp); } } else { /* No incr amount given so use 1. */ @@ -2499,9 +2508,8 @@ TclCompileLappendCmd( varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, - &localIndex, &simpleVarName, &isScalar, - mapPtr->loc[eclIndex].line[1]); + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + &localIndex, &simpleVarName, &isScalar, 1); /* * If we are doing an assignment, push the new value. In the no values @@ -2606,8 +2614,8 @@ TclCompileLassignCmd( * Generate the next variable name. */ - PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, - &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[idx+2]); + PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, + &simpleVarName, &isScalar, idx+2); /* * Emit instructions to get the idx'th item out of the list value on @@ -2943,9 +2951,8 @@ TclCompileLsetCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, - &localIndex, &simpleVarName, &isScalar, - mapPtr->loc[eclIndex].line[1]); + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + &localIndex, &simpleVarName, &isScalar, 1); /* * Push the "index" args and the new element value. @@ -3445,9 +3452,8 @@ TclCompileSetCmd( */ varTokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, - &localIndex, &simpleVarName, &isScalar, - mapPtr->loc[eclIndex].line[1]); + PushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR, + &localIndex, &simpleVarName, &isScalar, 1); /* * If we are doing an assignment, push the new value. @@ -3728,7 +3734,7 @@ TclCompileStringMatchCmd( } PushLiteral(envPtr, str, length); } else { - envPtr->line = mapPtr->loc[eclIndex].line[i+1+nocase]; + SetLineInformation (i+1+nocase); CompileTokens(envPtr, tokenPtr, interp); } tokenPtr = TokenAfter(tokenPtr); @@ -3794,7 +3800,7 @@ TclCompileStringLenCmd( len = sprintf(buf, "%d", len); PushLiteral(envPtr, buf, len); } else { - envPtr->line = mapPtr->loc[eclIndex].line[1]; + SetLineInformation (1); CompileTokens(envPtr, tokenPtr, interp); TclEmitOpcode(INST_STR_LEN, envPtr); } @@ -3844,6 +3850,7 @@ TclCompileSwitchCmd( Tcl_Token **bodyToken; /* Array of pointers to pattern list items. */ int *bodyLines; /* Array of line numbers for body list * items. */ + int** bodyNext; int foundDefault; /* Flag to indicate whether a "default" clause * is present. */ @@ -3862,6 +3869,7 @@ TclCompileSwitchCmd( int isListedArms = 0; int i, valueIndex; DefineLineInformation; /* TIP #280 */ + int* clNext = envPtr->clNext; /* * Only handle the following versions: @@ -4040,6 +4048,7 @@ TclCompileSwitchCmd( bodyTokenArray = (Tcl_Token *) ckalloc(sizeof(Tcl_Token) * numWords); bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords); bodyLines = (int *) ckalloc(sizeof(int) * numWords); + bodyNext = (int **) ckalloc(sizeof(int*) * numWords); /* * Locate the start of the arms within the overall word. @@ -4083,6 +4092,7 @@ TclCompileSwitchCmd( ckfree((char *) bodyToken); ckfree((char *) bodyTokenArray); ckfree((char *) bodyLines); + ckfree((char *) bodyNext); return TCL_ERROR; } @@ -4093,7 +4103,10 @@ TclCompileSwitchCmd( */ TclAdvanceLines(&bline, p, bodyTokenArray[i].start); + TclAdvanceContinuations (&bline, &clNext, + bodyTokenArray[i].start - envPtr->source); bodyLines[i] = bline; + bodyNext[i] = clNext; p = bodyTokenArray[i].start; while (isspace(UCHAR(*tokenStartPtr))) { @@ -4121,6 +4134,7 @@ TclCompileSwitchCmd( ckfree((char *) bodyToken); ckfree((char *) bodyTokenArray); ckfree((char *) bodyLines); + ckfree((char *) bodyNext); return TCL_ERROR; } @@ -4141,6 +4155,7 @@ TclCompileSwitchCmd( bodyToken = (Tcl_Token **) ckalloc(sizeof(Tcl_Token *) * numWords); bodyLines = (int *) ckalloc(sizeof(int) * numWords); + bodyNext = (int **) ckalloc(sizeof(int*) * numWords); bodyTokenArray = NULL; for (i=0 ; i<numWords ; i++) { /* @@ -4153,6 +4168,7 @@ TclCompileSwitchCmd( tokenPtr->numComponents != 1) { ckfree((char *) bodyToken); ckfree((char *) bodyLines); + ckfree((char *) bodyNext); return TCL_ERROR; } bodyToken[i] = tokenPtr+1; @@ -4162,6 +4178,7 @@ TclCompileSwitchCmd( */ bodyLines[i] = mapPtr->loc[eclIndex].line[valueIndex+1+i]; + bodyNext[i] = mapPtr->loc[eclIndex].next[valueIndex+1+i]; tokenPtr = TokenAfter(tokenPtr); } } @@ -4175,6 +4192,7 @@ TclCompileSwitchCmd( bodyToken[numWords-1]->start[0] == '-') { ckfree((char *) bodyToken); ckfree((char *) bodyLines); + ckfree((char *) bodyNext); if (bodyTokenArray != NULL) { ckfree((char *) bodyTokenArray); } @@ -4186,7 +4204,7 @@ TclCompileSwitchCmd( * First, we push the value we're matching against on the stack. */ - envPtr->line = mapPtr->loc[eclIndex].line[valueIndex]; + SetLineInformation (valueIndex); CompileTokens(envPtr, valueTokenPtr, interp); /* @@ -4308,6 +4326,7 @@ TclCompileSwitchCmd( */ envPtr->line = bodyLines[i+1]; /* TIP #280 */ + envPtr->clNext = bodyNext[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); /* @@ -4359,6 +4378,7 @@ TclCompileSwitchCmd( ckfree((char *) finalFixups); ckfree((char *) bodyToken); ckfree((char *) bodyLines); + ckfree((char *) bodyNext); if (bodyTokenArray != NULL) { ckfree((char *) bodyTokenArray); } @@ -4520,6 +4540,7 @@ TclCompileSwitchCmd( TclEmitOpcode(INST_POP, envPtr); envPtr->currStackDepth = savedStackDepth + 1; envPtr->line = bodyLines[i+1]; /* TIP #280 */ + envPtr->clNext = bodyNext[i+1]; /* TIP #280 */ TclCompileCmdWord(interp, bodyToken[i+1], 1, envPtr); if (!foundDefault) { @@ -4536,6 +4557,7 @@ TclCompileSwitchCmd( ckfree((char *) bodyToken); ckfree((char *) bodyLines); + ckfree((char *) bodyNext); if (bodyTokenArray != NULL) { ckfree((char *) bodyTokenArray); } @@ -4792,7 +4814,7 @@ TclCompileWhileCmd( * Compile the loop body. */ - envPtr->line = mapPtr->loc[eclIndex].line[2]; + SetLineInformation (2); bodyCodeOffset = ExceptionRangeStarts(envPtr, range); CompileBody(envPtr, bodyTokenPtr, interp); ExceptionRangeEnds(envPtr, range); @@ -4812,7 +4834,7 @@ TclCompileWhileCmd( testCodeOffset += 3; } envPtr->currStackDepth = savedStackDepth; - envPtr->line = mapPtr->loc[eclIndex].line[1]; + SetLineInformation (1); TclCompileExprWords(interp, testTokenPtr, 1, envPtr); envPtr->currStackDepth = savedStackDepth + 1; @@ -4877,7 +4899,8 @@ PushVarName( int *localIndexPtr, /* Must not be NULL. */ int *simpleVarNamePtr, /* Must not be NULL. */ int *isScalarPtr, /* Must not be NULL. */ - int line) /* Line the token starts on. */ + int line, /* Line the token starts on. */ + int* clNext) /* Reference to offset of next hidden cont. line */ { register const char *p; const char *name, *elName; @@ -5061,6 +5084,7 @@ PushVarName( if (elName != NULL) { if (elNameChars) { envPtr->line = line; + envPtr->clNext = clNext; TclCompileTokens(interp, elemTokenPtr, elemTokenCount, envPtr); } else { PushLiteral(envPtr, "", 0); @@ -5072,6 +5096,7 @@ PushVarName( */ envPtr->line = line; + envPtr->clNext = clNext; CompileTokens(envPtr, varTokenPtr, interp); } @@ -5849,9 +5874,8 @@ TclCompileUpvarCmd( localTokenPtr = TokenAfter(otherTokenPtr); CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarName(interp, localTokenPtr, envPtr, TCL_CREATE_VAR, - &localIndex, &simpleVarName, &isScalar, - mapPtr->loc[eclIndex].line[1]); + PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR, + &localIndex, &simpleVarName, &isScalar, 1); if((localIndex < 0) || !isScalar) { return TCL_ERROR; @@ -5942,9 +5966,8 @@ TclCompileNamespaceCmd( localTokenPtr = TokenAfter(otherTokenPtr); CompileWord(envPtr, otherTokenPtr, interp, 1); - PushVarName(interp, localTokenPtr, envPtr, TCL_CREATE_VAR, - &localIndex, &simpleVarName, &isScalar, - mapPtr->loc[eclIndex].line[1]); + PushVarNameWord(interp, localTokenPtr, envPtr, TCL_CREATE_VAR, + &localIndex, &simpleVarName, &isScalar, 1); if((localIndex < 0) || !isScalar) { return TCL_ERROR; @@ -6444,8 +6467,8 @@ TclCompileInfoExistsCmd( */ tokenPtr = TokenAfter(parsePtr->tokenPtr); - PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, - &simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[1]); + PushVarNameWord(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex, + &simpleVarName, &isScalar, 1); /* * Emit instruction to check the variable for existence. diff --git a/generic/tclCompile.c b/generic/tclCompile.c index 2ea99ac..403e487 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.146.2.10 2009/07/16 20:50:54 dgp Exp $ + * RCS: @(#) $Id: tclCompile.c,v 1.146.2.11 2009/08/25 21:01:05 andreas_kupries Exp $ */ #include "tclInt.h" @@ -431,7 +431,8 @@ static void PrintSourceToObj(Tcl_Obj *appendObj, */ static void EnterCmdWordData(ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token *tokenPtr, const char *cmd, int len, - int numWords, int line, int **lines); + int numWords, int line, int* clNext, int **lines, + CompileEnv* envPtr); /* * The structure below defines the bytecode Tcl object type by means of @@ -487,6 +488,7 @@ TclSetByteCodeFromAny( register int i; int length, result = TCL_OK; const char *stringPtr; + ContLineLoc* clLocPtr; #ifdef TCL_COMPILE_DEBUG if (!traceInitialized) { @@ -508,6 +510,25 @@ TclSetByteCodeFromAny( TclInitCompileEnv(interp, &compEnv, stringPtr, length, iPtr->invokeCmdFramePtr, iPtr->invokeWord); + /* + * Now we check if we have data about invisible continuation lines for the + * script, and make it available to the compile environment, if so. + * + * It is not clear if the script Tcl_Obj* can be free'd while the compiler + * 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 in the function TclFreeCompileEnv (), + * found in this file. The "lineCLPtr" hashtable is managed in the file + * "tclObj.c". + */ + + clLocPtr = TclContinuationsGet (objPtr); + if (clLocPtr) { + compEnv.clLoc = clLocPtr; + compEnv.clNext = &compEnv.clLoc->loc[0]; + Tcl_Preserve (compEnv.clLoc); + } + TclCompileScript(interp, stringPtr, length, &compEnv); /* @@ -982,6 +1003,15 @@ TclInitCompileEnv( TclStackFree(interp, ctxPtr); } + /* + * Initialize the data about invisible continuation lines as empty, + * i.e. not used. The caller (TclSetByteCodeFromAny) will set this up, if + * such data is available. + */ + + envPtr->clLoc = NULL; + envPtr->clNext = NULL; + envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace; envPtr->auxDataArrayNext = 0; envPtr->auxDataArrayEnd = COMPILEENV_INIT_AUX_DATA_SIZE; @@ -1036,6 +1066,16 @@ TclFreeCompileEnv( if (envPtr->extCmdMapPtr) { ckfree((char *) envPtr->extCmdMapPtr); } + + /* + * If we used data about invisible continuation lines, then now is the + * time to release on our hold on it. The lock was set in function + * TclSetByteCodeFromAny(), found in this file. + */ + + if (envPtr->clLoc) { + Tcl_Release (envPtr->clLoc); + } } /* @@ -1163,6 +1203,7 @@ TclCompileScript( /* TIP #280 */ ExtCmdLoc *eclPtr = envPtr->extCmdMapPtr; int *wlines, wlineat, cmdLine; + int* clNext; Tcl_Parse *parsePtr = (Tcl_Parse *) TclStackAlloc(interp, sizeof(Tcl_Parse)); @@ -1188,6 +1229,7 @@ TclCompileScript( p = script; bytesLeft = numBytes; cmdLine = envPtr->line; + clNext = envPtr->clNext; do { if (Tcl_ParseCommand(interp, p, bytesLeft, 0, parsePtr) != TCL_OK) { /* @@ -1287,10 +1329,12 @@ TclCompileScript( */ TclAdvanceLines(&cmdLine, p, parsePtr->commandStart); + TclAdvanceContinuations (&cmdLine, &clNext, + parsePtr->commandStart - envPtr->source); EnterCmdWordData(eclPtr, parsePtr->commandStart - envPtr->source, - parsePtr->tokenPtr, parsePtr->commandStart, - parsePtr->commandSize, parsePtr->numWords, cmdLine, - &wlines); + parsePtr->tokenPtr, parsePtr->commandStart, + parsePtr->commandSize, parsePtr->numWords, cmdLine, + clNext, &wlines, envPtr); wlineat = eclPtr->nuloc - 1; /* @@ -1303,6 +1347,8 @@ TclCompileScript( tokenPtr += (tokenPtr->numComponents + 1)) { envPtr->line = eclPtr->loc[wlineat].line[wordIdx]; + envPtr->clNext = eclPtr->loc [wlineat].next [wordIdx]; + if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) { /* * The word is not a simple string of characters. @@ -1463,6 +1509,12 @@ TclCompileScript( */ objIndex = TclRegisterNewLiteral(envPtr, tokenPtr[1].start, tokenPtr[1].size); + + if (envPtr->clNext) { + TclContinuationsEnterDerived (envPtr->literalArrayPtr[objIndex].objPtr, + tokenPtr[1].start - envPtr->source, + eclPtr->loc [wlineat].next [wordIdx]); + } } TclEmitPush(objIndex, envPtr); } /* for loop */ @@ -1524,7 +1576,9 @@ TclCompileScript( */ ckfree((char *) eclPtr->loc[wlineat].line); + ckfree((char *) eclPtr->loc[wlineat].next); eclPtr->loc[wlineat].line = wlines; + eclPtr->loc[wlineat].next = NULL; } /* end if parsePtr->numWords > 0 */ /* @@ -1540,6 +1594,7 @@ TclCompileScript( */ TclAdvanceLines(&cmdLine, parsePtr->commandStart, p); + TclAdvanceContinuations (&cmdLine, &clNext, p - envPtr->source); Tcl_FreeParse(parsePtr); } while (bytesLeft > 0); @@ -1600,6 +1655,41 @@ TclCompileTokens( int numObjsToConcat, nameBytes, localVarName, localVar; int length, i; unsigned char *entryCodeNext = envPtr->codeNext; +#define NUM_STATIC_POS 20 + int isLiteral, maxNumCL, numCL; + int* clPosition; + + /* + * 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. + * + * Note: Different to the equivalent code in function + * 'EvalTokensStandard()' (see file "tclBasic.c") we do not seem to need + * the 'adjust' variable. We also do not seem to need code which merges + * continuation line information of multiple words which concat'd at + * runtime. Either that or I have not managed to find a test case for + * these two possibilities yet. It might be a difference between compile- + * versus runtime processing. + */ + + 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)); + } Tcl_DStringInit(&textBuffer); numObjsToConcat = 0; @@ -1612,6 +1702,36 @@ TclCompileTokens( case TCL_TOKEN_BS: length = Tcl_UtfBackslash(tokenPtr->start, NULL, buffer); Tcl_DStringAppend(&textBuffer, buffer, length); + + /* + * 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 = Tcl_DStringLength (&textBuffer); + + if (numCL >= maxNumCL) { + maxNumCL *= 2; + clPosition = (int*) ckrealloc ((char*)clPosition, + maxNumCL*sizeof(int)); + } + clPosition[numCL] = clPos; + numCL ++; + } + } break; case TCL_TOKEN_COMMAND: @@ -1627,6 +1747,12 @@ TclCompileTokens( TclEmitPush(literal, envPtr); numObjsToConcat++; Tcl_DStringFree(&textBuffer); + + if (numCL) { + TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr, + numCL, clPosition); + } + numCL = 0; } TclCompileScript(interp, tokenPtr->start+1, @@ -1737,6 +1863,12 @@ TclCompileTokens( Tcl_DStringLength(&textBuffer)); TclEmitPush(literal, envPtr); numObjsToConcat++; + + if (numCL) { + TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr, + numCL, clPosition); + } + numCL = 0; } /* @@ -1759,6 +1891,15 @@ TclCompileTokens( TclEmitPush(TclRegisterNewLiteral(envPtr, "", 0), envPtr); } Tcl_DStringFree(&textBuffer); + + /* + * Release the temp table we used to collect the locations of + * continuation lines, if any. + */ + + if (maxNumCL) { + ckfree ((char*) clPosition); + } } /* @@ -2397,11 +2538,14 @@ EnterCmdWordData( int len, int numWords, int line, - int **wlines) + int* clNext, + int **wlines, + CompileEnv* envPtr) { ECL *ePtr; const char *last; int wordIdx, wordLine, *wwlines; + int* wordNext; if (eclPtr->nuloc >= eclPtr->nloc) { /* @@ -2421,17 +2565,22 @@ EnterCmdWordData( ePtr = &eclPtr->loc[eclPtr->nuloc]; ePtr->srcOffset = srcOffset; ePtr->line = (int *) ckalloc(numWords * sizeof(int)); + ePtr->next = (int**) ckalloc (numWords * sizeof (int*)); ePtr->nline = numWords; wwlines = (int *) ckalloc(numWords * sizeof(int)); last = cmd; wordLine = line; + wordNext = clNext; for (wordIdx=0 ; wordIdx<numWords; wordIdx++, tokenPtr += tokenPtr->numComponents + 1) { - TclAdvanceLines(&wordLine, last, tokenPtr->start); + TclAdvanceLines (&wordLine, last, tokenPtr->start); + TclAdvanceContinuations (&wordLine, &wordNext, + tokenPtr->start - envPtr->source); wwlines[wordIdx] = (TclWordKnownAtCompileTime(tokenPtr, NULL) ? wordLine : -1); ePtr->line[wordIdx] = wordLine; + ePtr->next[wordIdx] = wordNext; last = tokenPtr->start; } diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 2eb8489..a86e8f1 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -9,7 +9,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclCompile.h,v 1.90.2.6 2009/07/14 16:33:12 andreas_kupries Exp $ + * RCS: @(#) $Id: tclCompile.h,v 1.90.2.7 2009/08/25 21:01:05 andreas_kupries Exp $ */ #ifndef _TCLCOMPILATION @@ -132,6 +132,9 @@ typedef struct ECL { int nline; /* Number of words in the command */ int *line; /* Line information for all words in the * command. */ + int** next; /* Transient information used by the compiler + * for tracking of hidden continuation + * lines. */ } ECL; typedef struct ExtCmdLoc { @@ -306,6 +309,13 @@ typedef struct CompileEnv { * should be issued; they should never be * issued repeatedly, as that is significantly * inefficient. */ + ContLineLoc* clLoc; /* If not NULL, the table holding the + * locations of the invisible continuation + * lines in the input script, to adjust the + * line counter. */ + int* clNext; /* If not NULL, it refers to the next slot in + * clLoc to check for an invisible + * continuation line. */ } CompileEnv; /* diff --git a/generic/tclInt.h b/generic/tclInt.h index b7e34c9..b39eeb6 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -13,7 +13,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclInt.h,v 1.362.2.7 2009/07/14 16:33:12 andreas_kupries Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.362.2.8 2009/08/25 21:01:05 andreas_kupries Exp $ */ #ifndef _TCLINT @@ -1155,6 +1155,36 @@ typedef struct CFWordBC { } CFWordBC; /* + * Structure to record the locations of invisible continuation lines in + * literal scripts, as character offset from the beginning of the script. Both + * compiler and direct evaluator use this information to adjust their line + * counters when tracking through the script, because when it is invoked the + * continuation line marker as a whole has been removed already, meaning that + * the \n which was part of it is gone as well, breaking regular line + * tracking. + * + * These structures are allocated and filled by both the function + * TclSubstTokens() in the file "tclParse.c" and its caller TclEvalEx() in the + * file "tclBasic.c", and stored in the thread-global hashtable "lineCLPtr" in + * file "tclObj.c". They are used by the functions TclSetByteCodeFromAny() and + * TclCompileScript(), both found in the file "tclCompile.c". Their memory is + * released by the function TclFreeObj(), in the file "tclObj.c", and also by + * the function TclThreadFinalizeObjects(), in the same file. + */ + +#define CLL_END (-1) + +typedef struct ContLineLoc { + int num; /* Number of entries in loc, not counting the final -1 + * marker entry */ + int loc[1]; /* Table of locations, as character offsets. The table + * is allocated as part of the structure, i.e. the loc + * array extends behind the nominal end of the + * structure. An entry containing the value -1 is put + * after the last location, as end-marker/sentinel. */ +} ContLineLoc; + +/* * The following macros define the allowed values for the type field of the * CmdFrame structure above. Some of the values occur only in the extended * location data referenced via the 'baseLocPtr'. @@ -1866,6 +1896,16 @@ typedef struct Interp { * invoking command. Alt view: An index to the * CmdFrame stack keyed by command argument * holders. */ + ContLineLoc* scriptCLLocPtr; + /* This table points to the location data for + * invisible continuation lines in the script, + * if any. This pointer is set by the function + * TclEvalObjEx() in file "tclBasic.c", and + * used by function ...() in the same file. + * It does for the eval/direct path of script + * execution what CompileEnv.clLoc does for + * the bytecode compiler. + */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. @@ -2457,6 +2497,7 @@ MODULE_SCOPE char tclEmptyString; *---------------------------------------------------------------- */ +MODULE_SCOPE void TclAdvanceContinuations(int* line, int** next, int loc); MODULE_SCOPE void TclAdvanceLines(int *line, const char *start, const char *end); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp* interp, @@ -2483,11 +2524,16 @@ MODULE_SCOPE int TclChanCaughtErrorBypass(Tcl_Interp *interp, Tcl_Channel chan); MODULE_SCOPE void TclCleanupLiteralTable(Tcl_Interp *interp, LiteralTable *tablePtr); +MODULE_SCOPE ContLineLoc* TclContinuationsEnter(Tcl_Obj* objPtr, int num, int* loc); +MODULE_SCOPE void TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext); +MODULE_SCOPE ContLineLoc* TclContinuationsGet(Tcl_Obj* objPtr); +MODULE_SCOPE void TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr); MODULE_SCOPE int TclDoubleDigits(char *buf, double value, int *signum); MODULE_SCOPE void TclDeleteNamespaceVars(Namespace *nsPtr); /* TIP #280 - Modified token based evulation, with line information */ MODULE_SCOPE int TclEvalEx(Tcl_Interp *interp, const char *script, - int numBytes, int flags, int line); + int numBytes, int flags, int line, + int* clNextOuter, CONST char* outerScript); MODULE_SCOPE int TclFileAttrsCmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE int TclFileCopyCmd(Tcl_Interp *interp, @@ -2575,8 +2621,8 @@ MODULE_SCOPE Tcl_Obj * TclLindexList(Tcl_Interp *interp, MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, int indexCount, Tcl_Obj *const indexArray[]); /* TIP #280 */ -MODULE_SCOPE void TclListLines(const char *listStr, int line, int n, - int *lines); +MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n, + int *lines, Tcl_Obj* const* elems); MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); MODULE_SCOPE int TclLoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr, int symc, const char *symbols[], @@ -2703,7 +2749,8 @@ MODULE_SCOPE int TclStringMatchObj(Tcl_Obj *stringObj, Tcl_Obj *patternObj, int flags); MODULE_SCOPE Tcl_Obj * TclStringObjReverse(Tcl_Obj *objPtr); MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, - int count, int *tokensLeftPtr, int line); + int count, int *tokensLeftPtr, int line, + int* clNextOuter, CONST char* outerScript); MODULE_SCOPE void TclTransferResult(Tcl_Interp *sourceInterp, int result, Tcl_Interp *targetInterp); MODULE_SCOPE Tcl_Obj * TclpNativeToNormalized(ClientData clientData); diff --git a/generic/tclObj.c b/generic/tclObj.c index 239865d..1b0a58c 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.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: tclObj.c,v 1.139.2.2 2009/05/08 02:23:52 msofer Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.139.2.3 2009/08/25 21:01:05 andreas_kupries Exp $ */ #include "tclInt.h" @@ -53,18 +53,43 @@ Tcl_Mutex tclObjMutex; char tclEmptyString = '\0'; char *tclEmptyStringRep = &tclEmptyString; - -#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) + /* - * Thread local table that is used to check that a Tcl_Obj was not allocated - * by some other thread. + * All static variables used in this file are collected into a single instance + * of the following structure. For multi-threaded implementations, there is + * one instance of this structure for each thread. + * + * Notice that different structures with the same name appear in other files. + * The structure defined below is used in this file only. */ + typedef struct ThreadSpecificData { + Tcl_HashTable* lineCLPtr; /* This table remembers for each Tcl_Obj + * generated by a call to the function + * EvalTokensStandard() from a literal text + * where bs+nl sequences occured in it, if + * any. I.e. this table keeps track of + * invisible/stripped continuation lines. Its + * keys are Tcl_Obj pointers, the values are + * ContLineLoc pointers. See the file + * tclCompile.h for the definition of this + * structure, and for references to all related + * places in the core. + */ +#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) + /* + * Thread local table that is used to check that a Tcl_Obj was not + * allocated by some other thread. + */ Tcl_HashTable *objThreadMap; +#endif /* TCL_MEM_DEBUG && TCL_THREADS */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; -#endif /* TCL_MEM_DEBUG && TCL_THREADS */ + +static void ContLineLocFree (char* clientData); +static void TclThreadFinalizeObjects (ClientData clientData); +static ThreadSpecificData* TclGetTables (void); /* * Nested Tcl_Obj deletion management support @@ -420,6 +445,313 @@ TclFinalizeObjects(void) } /* + *---------------------------------------------------------------------- + * + * TclGetTables -- + * + * This procedure is a helper which returns the thread-specific + * hash-table used to track continuation line information associated with + * Tcl_Obj*, and the objThreadMap, etc. + * + * Results: + * A reference to the thread-data. + * + * Side effects: + * May allocate memory for the thread-data. + * + * TIP #280 + *---------------------------------------------------------------------- + */ + +static ThreadSpecificData* +TclGetTables() +{ + /* + * Initialize the hashtable tracking invisible continuation lines. For + * the release we use a thread exit handler to ensure that this is done + * before TSD blocks are made invalid. The TclFinalizeObjects() which + * would be the natural place for this is invoked afterwards, meaning that + * we try to operate on a data structure already gone. + */ + + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + if (!tsdPtr->lineCLPtr) { + tsdPtr->lineCLPtr = (Tcl_HashTable*) ckalloc (sizeof (Tcl_HashTable)); + Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS); + Tcl_CreateThreadExitHandler (TclThreadFinalizeObjects,NULL); +#if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) + tsdPtr->objThreadMap = NULL; +#endif /* TCL_MEM_DEBUG && TCL_THREADS */ + } + return tsdPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclContinuationsEnter -- + * + * This procedure is a helper which saves the continuation line + * information associated with a Tcl_Obj*. + * + * Results: + * A reference to the newly created continuation line location table. + * + * Side effects: + * Allocates memory for the table of continuation line locations. + * + * TIP #280 + *---------------------------------------------------------------------- + */ + +ContLineLoc* +TclContinuationsEnter(Tcl_Obj* objPtr, + int num, + int* loc) +{ + int newEntry; + ThreadSpecificData *tsdPtr = TclGetTables(); + Tcl_HashEntry* hPtr = + Tcl_CreateHashEntry (tsdPtr->lineCLPtr, (char*) objPtr, &newEntry); + + ContLineLoc* clLocPtr = + (ContLineLoc*) ckalloc (sizeof(ContLineLoc) + num*sizeof(int)); + + clLocPtr->num = num; + memcpy (&clLocPtr->loc, loc, num*sizeof(int)); + clLocPtr->loc[num] = CLL_END; /* Sentinel */ + Tcl_SetHashValue (hPtr, clLocPtr); + + return clLocPtr; +} + +/* + *---------------------------------------------------------------------- + * + * TclContinuationsEnterDerived -- + * + * This procedure is a helper which computes the continuation line + * information associated with a Tcl_Obj* cut from the middle of a + * script. + * + * Results: + * None. + * + * Side effects: + * Allocates memory for the table of continuation line locations. + * + * TIP #280 + *---------------------------------------------------------------------- + */ + +void +TclContinuationsEnterDerived(Tcl_Obj* objPtr, int start, int* clNext) +{ + /* + * We have to handle invisible continuations lines here as well, despite + * the code we have in TclSubstTokens (TST) for that. Why ? Nesting. If + * our script is the sole argument to an 'eval' command, for example, the + * scriptCLLocPtr we are using was generated by a previous call to TST, + * and while the words we have here may contain continuation lines they + * are invisible already, and the inner call to TST had no bs+nl sequences + * to trigger its code. + * + * Luckily for us, the table we have to create here for the current word + * has to be a slice of the table currently in use, with the locations + * suitably modified to be relative to the start of the word instead of + * relative to the script. + * + * That is what we are doing now. Determine the slice we need, and if not + * empty, wrap it into a new table, and save the result into our + * thread-global hashtable, as usual. + */ + + /* + * First compute the range of the word within the script. + */ + + int length, end, num; + int* wordCLLast = clNext; + + Tcl_GetStringFromObj(objPtr, &length); + /* Is there a better way which doesn't shimmer ? */ + + end = start + length; /* first char after the word */ + + /* + * Then compute the table slice covering the range of + * the word. + */ + + while (*wordCLLast >= 0 && *wordCLLast < end) { + wordCLLast++; + } + + /* + * And generate the table from the slice, if it was + * not empty. + */ + + num = wordCLLast - clNext; + if (num) { + int i; + ContLineLoc* clLocPtr = + TclContinuationsEnter(objPtr, num, clNext); + + /* + * Re-base the locations. + */ + + for (i=0;i<num;i++) { + clLocPtr->loc[i] -= start; + + /* + * Continuation lines coming before the string and affecting us + * should not happen, due to the proper maintenance of clNext + * during compilation. + */ + + if (clLocPtr->loc[i] < 0) { + Tcl_Panic("Derived ICL data for object using offsets from before the script"); + } + } + } +} + +/* + *---------------------------------------------------------------------- + * + * TclContinuationsCopy -- + * + * This procedure is a helper which copies the continuation line + * information associated with a Tcl_Obj* to another Tcl_Obj*. + * It is assumed that both contain the same string/script. Use + * this when a script is duplicated because it was shared. + * + * Results: + * None. + * + * Side effects: + * Allocates memory for the table of continuation line locations. + * + * TIP #280 + *---------------------------------------------------------------------- + */ + +void +TclContinuationsCopy(Tcl_Obj* objPtr, Tcl_Obj* originObjPtr) +{ + ThreadSpecificData *tsdPtr = TclGetTables(); + Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) originObjPtr); + + if (hPtr) { + ContLineLoc* clLocPtr = (ContLineLoc*) Tcl_GetHashValue (hPtr); + + TclContinuationsEnter(objPtr, clLocPtr->num, clLocPtr->loc); + } +} + +/* + *---------------------------------------------------------------------- + * + * TclContinuationsGet -- + * + * This procedure is a helper which retrieves the continuation line + * information associated with a Tcl_Obj*, if it has any. + * + * Results: + * A reference to the continuation line location table, or NULL + * if the Tcl_Obj* has no such information associated with it. + * + * Side effects: + * None. + * + * TIP #280 + *---------------------------------------------------------------------- + */ + +ContLineLoc* +TclContinuationsGet(Tcl_Obj* objPtr) +{ + ThreadSpecificData *tsdPtr = TclGetTables(); + Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char*) objPtr); + + if (hPtr) { + return (ContLineLoc*) Tcl_GetHashValue (hPtr); + } else { + return NULL; + } +} + +/* + *---------------------------------------------------------------------- + * + * TclThreadFinalizeObjects -- + * + * This procedure is a helper which releases all continuation line + * information currently known. It is run as a thread exit handler. + * + * Results: + * None. + * + * Side effects: + * Releases memory. + * + * TIP #280 + *---------------------------------------------------------------------- + */ + +static void +TclThreadFinalizeObjects (ClientData clientData) +{ + /* + * Release the hashtable tracking invisible continuation lines. + */ + + Tcl_HashEntry *hPtr; + Tcl_HashSearch hSearch; + ThreadSpecificData *tsdPtr = TclGetTables(); + + for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch); + hPtr != NULL; + hPtr = Tcl_NextHashEntry(&hSearch)) { + /* + * We are not using Tcl_EventuallyFree (as in TclFreeObj()) because + * here we can be sure that the compiler will not hold references to + * the data in the hashtable, and using TEF might bork the + * finalization sequence. + */ + ContLineLocFree (Tcl_GetHashValue (hPtr)); + Tcl_DeleteHashEntry (hPtr); + } + Tcl_DeleteHashTable (tsdPtr->lineCLPtr); + tsdPtr->lineCLPtr = NULL; +} + +/* + *---------------------------------------------------------------------- + * + * ContLineLocFree -- + * + * The freProc for continuation line location tables. + * + * Results: + * None. + * + * Side effects: + * Releases memory. + * + * TIP #280 + *---------------------------------------------------------------------- + */ + +static void +ContLineLocFree (char* clientData) +{ + ckfree (clientData); +} + +/* *-------------------------------------------------------------- * * Tcl_RegisterObjType -- @@ -624,7 +956,7 @@ TclDbInitNewObj( Tcl_HashEntry *hPtr; Tcl_HashTable *tablePtr; int isNew; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TclGetTables(); if (tsdPtr->objThreadMap == NULL) { tsdPtr->objThreadMap = (Tcl_HashTable *) @@ -881,6 +1213,28 @@ TclFreeObj( } ObjDeletionUnlock(context); } + + /* + * We cannot use TclGetContinuationTable() here, because that may + * re-initialize the thread-data for calls coming after the + * finalization. We have to access it using the low-level call and then + * check for validity. This function can be called after + * TclFinalizeThreadData() has already killed the thread-global data + * structures. Performing TCL_TSD_INIT will leave us with an + * un-initialized memory block upon which we crash (if we where to access + * the uninitialized hashtable). + */ + + { + ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey); + if (tsdPtr->lineCLPtr) { + Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr); + if (hPtr) { + Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree); + Tcl_DeleteHashEntry (hPtr); + } + } + } } #else /* TCL_MEM_DEBUG */ @@ -946,6 +1300,28 @@ TclFreeObj( ObjDeletionUnlock(context); } } + + /* + * We cannot use TclGetContinuationTable() here, because that may + * re-initialize the thread-data for calls coming after the + * finalization. We have to access it using the low-level call and then + * check for validity. This function can be called after + * TclFinalizeThreadData() has already killed the thread-global data + * structures. Performing TCL_TSD_INIT will leave us with an + * un-initialized memory block upon which we crash (if we where to access + * the uninitialized hashtable). + */ + + { + ThreadSpecificData* tsdPtr = TCL_TSD_INIT(&dataKey); + if (tsdPtr->lineCLPtr) { + Tcl_HashEntry* hPtr = Tcl_FindHashEntry (tsdPtr->lineCLPtr, (char *) objPtr); + if (hPtr) { + Tcl_EventuallyFree (Tcl_GetHashValue (hPtr), ContLineLocFree); + Tcl_DeleteHashEntry (hPtr); + } + } + } } #endif diff --git a/generic/tclParse.c b/generic/tclParse.c index 769be99..3946511 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.62.2.2 2008/12/01 22:39:59 dgp Exp $ + * RCS: @(#) $Id: tclParse.c,v 1.62.2.3 2009/08/25 21:01:05 andreas_kupries Exp $ */ #include "tclInt.h" @@ -1554,7 +1554,7 @@ Tcl_ParseVar( } code = TclSubstTokens(interp, parsePtr->tokenPtr, parsePtr->numTokens, - NULL, 1); + NULL, 1, NULL, NULL); TclStackFree(interp, parsePtr); if (code != TCL_OK) { return NULL; @@ -2063,7 +2063,7 @@ Tcl_SubstObj( endTokenPtr = parsePtr->tokenPtr + parsePtr->numTokens; tokensLeft = parsePtr->numTokens; code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft, - &tokensLeft, 1); + &tokensLeft, 1, NULL, NULL); if (code == TCL_OK) { Tcl_FreeParse(parsePtr); TclStackFree(interp, parsePtr); @@ -2108,7 +2108,7 @@ Tcl_SubstObj( } code = TclSubstTokens(interp, endTokenPtr - tokensLeft, tokensLeft, - &tokensLeft, 1); + &tokensLeft, 1, NULL, NULL); } } @@ -2146,10 +2146,31 @@ TclSubstTokens( int *tokensLeftPtr, /* If not NULL, points to memory where an * integer representing the number of tokens * left to be substituted will be written */ - int line) /* The line the script starts on. */ + 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. + */ { Tcl_Obj *result; int code = TCL_OK; +#define NUM_STATIC_POS 20 + int isLiteral, maxNumCL, numCL, i, adjust; + int* clPosition; + Interp* iPtr = (Interp*) interp; + int inFile = iPtr->evalFlags & TCL_EVAL_FILE; /* * Each pass through this loop will substitute one token, and its @@ -2161,6 +2182,31 @@ TclSubstTokens( * of Tcl_SetObjResult(interp, Tcl_GetObjResult(interp)) and omit them. */ + /* + * 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; result = NULL; for (; count>0 && code==TCL_OK ; count--, tokenPtr++) { Tcl_Obj *appendObj = NULL; @@ -2178,6 +2224,41 @@ TclSubstTokens( appendByteLength = Tcl_UtfBackslash(tokenPtr->start, NULL, utfCharBytes); append = utfCharBytes; + /* + * 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 ((appendByteLength == 1) && (utfCharBytes[0] == ' ') && + (tokenPtr->start[1] == '\n')) { + if (isLiteral) { + int clPos; + if (result == 0) { + clPos = 0; + } else { + Tcl_GetStringFromObj(result, &clPos); + } + + if (numCL >= maxNumCL) { + maxNumCL *= 2; + clPosition = (int*) ckrealloc ((char*)clPosition, + maxNumCL*sizeof(int)); + } + clPosition[numCL] = clPos; + numCL ++; + } + adjust ++; + } break; case TCL_TOKEN_COMMAND: { @@ -2186,9 +2267,24 @@ TclSubstTokens( iPtr->numLevels++; code = TclInterpReady(interp); if (code == TCL_OK) { + /* + * Test cases: info-30.{6,8,9} + */ + + int theline; + TclAdvanceContinuations (&line, &clNextOuter, + tokenPtr->start - outerScript); + theline = line + adjust; /* TIP #280: Transfer line information to nested command */ code = TclEvalEx(interp, tokenPtr->start+1, tokenPtr->size-2, - 0, line); + 0, theline, clNextOuter, outerScript); + /* + * Restore flag reset by nested eval for future bracketed + * commands and their cmdframe setup + */ + if (inFile) { + iPtr->evalFlags |= TCL_EVAL_FILE; + } } iPtr->numLevels--; appendObj = Tcl_GetObjResult(interp); @@ -2205,7 +2301,7 @@ TclSubstTokens( */ code = TclSubstTokens(interp, tokenPtr+2, - tokenPtr->numComponents - 1, NULL, line); + tokenPtr->numComponents - 1, NULL, line, NULL, NULL); arrayIndex = Tcl_GetObjResult(interp); Tcl_IncrRefCount(arrayIndex); } @@ -2289,6 +2385,26 @@ TclSubstTokens( if (code != TCL_ERROR) { /* Keep error message in result! */ if (result != NULL) { Tcl_SetObjResult(interp, result); + /* + * 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(result, numCL, clPosition); + } + + /* + * Release the temp table we used to collect the locations of + * continuation lines, if any. + */ + + if (maxNumCL) { + ckfree ((char*) clPosition); + } } else { Tcl_ResetResult(interp); } diff --git a/generic/tclProc.c b/generic/tclProc.c index 717b8bc..3c8f810 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.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: tclProc.c,v 1.139.2.5 2009/06/13 14:25:13 dgp Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.139.2.6 2009/08/25 21:01:05 andreas_kupries Exp $ */ #include "tclInt.h" @@ -430,8 +430,18 @@ TclCreateProc( */ if (Tcl_IsShared(bodyPtr)) { + Tcl_Obj* sharedBodyPtr = bodyPtr; + bytes = TclGetStringFromObj(bodyPtr, &length); bodyPtr = Tcl_NewStringObj(bytes, length); + + /* + * TIP #280. + * Ensure that the continuation line data for the original body is + * not lost and applies to the new body as well. + */ + + TclContinuationsCopy (bodyPtr, sharedBodyPtr); } /* @@ -2530,7 +2540,7 @@ SetLambdaFromAny( * location (line of 2nd list element). */ - TclListLines(name, contextPtr->line[1], 2, buf); + TclListLines(objPtr, contextPtr->line[1], 2, buf, NULL); cfPtr->level = -1; cfPtr->type = contextPtr->type; diff --git a/generic/tclVar.c b/generic/tclVar.c index 8f83738..3a3a10f 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -16,7 +16,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclVar.c,v 1.160.2.4 2009/07/16 20:50:54 dgp Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.160.2.5 2009/08/25 21:01:05 andreas_kupries Exp $ */ #include "tclInt.h" @@ -1878,6 +1878,14 @@ TclPtrSetVar( } else { if (Tcl_IsShared(oldValuePtr)) { /* Append to copy. */ varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr); + + /* + * TIP #280. + * Ensure that the continuation line data for the string + * is not lost and applies to the extended script as well. + */ + TclContinuationsCopy (varPtr->value.objPtr, oldValuePtr); + TclDecrRefCount(oldValuePtr); oldValuePtr = varPtr->value.objPtr; Tcl_IncrRefCount(oldValuePtr); /* Since var is ref */ |