summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tclBasic.c300
-rw-r--r--generic/tclCmdMZ.c45
-rw-r--r--generic/tclCompCmds.c354
-rw-r--r--generic/tclCompile.c183
-rw-r--r--generic/tclCompile.h10
-rw-r--r--generic/tclExecute.c6
-rw-r--r--generic/tclInt.h62
-rw-r--r--generic/tclObj.c379
-rw-r--r--generic/tclProc.c14
-rw-r--r--generic/tclVar.c11
10 files changed, 1038 insertions, 326 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:
*/
-
diff --git a/generic/tclCmdMZ.c b/generic/tclCmdMZ.c
index 9114e50..ef172fc 100644
--- a/generic/tclCmdMZ.c
+++ b/generic/tclCmdMZ.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: tclCmdMZ.c,v 1.82.2.29 2007/06/27 17:29:22 dgp Exp $
+ * RCS: @(#) $Id: tclCmdMZ.c,v 1.82.2.30 2009/08/25 20:59:10 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -139,8 +139,9 @@ static void TraceCommandProc _ANSI_ARGS_((ClientData clientData,
static Tcl_CmdObjTraceProc TraceExecutionProc;
#ifdef TCL_TIP280
-static void ListLines _ANSI_ARGS_((CONST char* listStr, int line,
- int n, int* lines));
+static void ListLines _ANSI_ARGS_((Tcl_Obj* listObj, int line,
+ int n, int* lines,
+ Tcl_Obj* const* elems));
#endif
/*
*----------------------------------------------------------------------
@@ -2925,7 +2926,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
ctx.line = (int*) ckalloc (objc * sizeof(int));
ctx.nline = objc;
- ListLines (Tcl_GetString (blist), bline, objc, ctx.line);
+ ListLines (blist, bline, objc, ctx.line, objv);
} else {
int k;
/* Dynamic code word ... All elements are relative to themselves */
@@ -2961,7 +2962,7 @@ Tcl_SwitchObjCmd(dummy, interp, objc, objv)
result = Tcl_EvalObjEx(interp, objv[j], 0);
#else
/* TIP #280. Make invoking context available to switch branch */
- result = TclEvalObjEx(interp, objv[j], 0, &ctx, j);
+ result = TclEvalObjEx(interp, objv[j], 0, &ctx, splitObjs ? j : bidx+j);
if (splitObjs) {
ckfree ((char*) ctx.line);
if (pc && (ctx.type == TCL_LOCATION_SOURCE)) {
@@ -4989,24 +4990,34 @@ Tcl_WhileObjCmd(dummy, interp, objc, objv)
#ifdef TCL_TIP280
static void
-ListLines(listStr, line, n, lines)
- CONST char* listStr; /* Pointer to 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 */
+ListLines(listObj, line, n, lines, elems)
+ 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 */
+ Tcl_Obj* const* elems; /* The list elems as Tcl_Obj*, in need of derived
+ * continuation data */
{
- int i;
- int length = strlen( listStr);
- CONST char *element = NULL;
- CONST char* next = NULL;
+ int i;
+ CONST char* listStr = Tcl_GetString (listObj);
+ CONST char* listHead = listStr;
+ int length = strlen( listStr);
+ CONST char* element = NULL;
+ CONST char* 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 (clNext) {
+ TclContinuationsEnterDerived (elems[i], element - listHead, clNext);
+ }
+
lines [i] = line;
length -= (next - listStr);
TclAdvanceLines (&line, element, next); /* Element */
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 3c83a58..26c387b 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.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: tclCompCmds.c,v 1.39.2.7 2008/07/21 19:37:42 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.39.2.8 2009/08/25 20:59:10 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -27,11 +27,37 @@ static void FreeForeachInfo _ANSI_ARGS_((ClientData clientData));
static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr));
+
+#define TclPushVarNameWord(i,v,e,f,l,s,sc,word) \
+ TclPushVarName (i,v,e,f,l,s,sc) /* ignoring word */
+
+#define DefineLineInformation /**/
+#define SetLineInformation(word) /**/
#else
static int TclPushVarName _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Token *varTokenPtr, CompileEnv *envPtr, int flags,
int *localIndexPtr, int *simpleVarNamePtr, int *isScalarPtr,
- int line));
+ int line, int* clNext));
+
+#define TclPushVarNameWord(i,v,e,f,l,s,sc,word) \
+ TclPushVarName (i,v,e,f,l,s,sc, \
+ mapPtr->loc [eclIndex].line [(word)], \
+ mapPtr->loc [eclIndex].next [(word)])
+
+/* TIP #280 : Remember the per-word line information of the current
+ * command. An index is used instead of a pointer as recursive compilation may
+ * reallocate, i.e. move, the array. This is also the reason to save the nuloc
+ * now, it may change during the course of the function.
+ *
+ * Macros to encapsulate the variable definition and setup, and their use.
+ */
+#define DefineLineInformation \
+ 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)]
#endif
/*
@@ -85,15 +111,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
int simpleVarName, isScalar, localIndex, numWords;
int code = TCL_OK;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
numWords = parsePtr->numWords;
if (numWords == 1) {
@@ -125,13 +143,8 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-#ifndef TCL_TIP280
- &localIndex, &simpleVarName, &isScalar);
-#else
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
if (code != TCL_OK) {
goto done;
}
@@ -148,9 +161,7 @@ TclCompileAppendCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -271,15 +282,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
int code;
int savedStackDepth = envPtr->currStackDepth;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
@@ -343,9 +346,7 @@ TclCompileCatchCmd(interp, parsePtr, envPtr)
* errors in the substitution are not catched [Bug 219184]
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
if (cmdTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
startOffset = (envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, cmdTokenPtr+1, 1, envPtr);
@@ -493,6 +494,8 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
{
Tcl_Token *firstWordPtr;
+ DefineLineInformation;
+
if (parsePtr->numWords == 1) {
Tcl_ResetResult(interp);
Tcl_AppendToObj(Tcl_GetObjResult(interp),
@@ -500,11 +503,7 @@ TclCompileExprCmd(interp, parsePtr, envPtr)
return TCL_ERROR;
}
-#ifdef TCL_TIP280
- /* TIP #280 : Use the per-word line information of the current command.
- */
- envPtr->line = envPtr->extCmdMapPtr->loc [envPtr->extCmdMapPtr->nuloc - 1].line [1];
-#endif
+ SetLineInformation (1);
firstWordPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
return TclCompileExprWords(interp, firstWordPtr, (parsePtr->numWords-1),
@@ -543,15 +542,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if (parsePtr->numWords != 5) {
Tcl_ResetResult(interp);
@@ -601,9 +592,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
* Inline compile the initial command.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
code = TclCompileCmdWord(interp, startTokenPtr+1,
startTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -635,9 +624,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [4];
-#endif
+ SetLineInformation (4);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
envPtr->currStackDepth = savedStackDepth + 1;
@@ -660,9 +647,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
nextCodeOffset = (envPtr->codeNext - envPtr->codeStart);
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [3];
-#endif
+ SetLineInformation (3);
envPtr->currStackDepth = savedStackDepth;
code = TclCompileCmdWord(interp, nextTokenPtr+1,
nextTokenPtr->numComponents, envPtr);
@@ -693,9 +678,7 @@ TclCompileForCmd(interp, parsePtr, envPtr)
nextCodeOffset += 3;
testCodeOffset += 3;
}
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
envPtr->currStackDepth = savedStackDepth;
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
@@ -786,14 +769,8 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
char buffer[32 + TCL_INTEGER_SPACE];
int savedStackDepth = envPtr->currStackDepth;
+ DefineLineInformation;
#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
int bodyIndex;
#endif
@@ -976,9 +953,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
i < numWords-1;
i++, tokenPtr += (tokenPtr->numComponents + 1)) {
if ((i%2 == 0) && (i > 0)) {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -1016,9 +991,7 @@ TclCompileForeachCmd(interp, parsePtr, envPtr)
* Inline compile the loop body.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [bodyIndex];
-#endif
+ SetLineInformation (bodyIndex);
envPtr->exceptArrayPtr[range].codeOffset =
(envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
@@ -1248,15 +1221,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
int boolVal; /* value of static condition */
int compileScripts = 1;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* Only compile the "if" command if all arguments are simple
@@ -1339,9 +1304,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
}
} else {
Tcl_ResetResult(interp);
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [wordIdx];
-#endif
+ SetLineInformation (wordIdx);
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
@@ -1398,9 +1361,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
*/
if (compileScripts) {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [wordIdx];
-#endif
+ SetLineInformation (wordIdx);
envPtr->currStackDepth = savedStackDepth;
code = TclCompileCmdWord(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
@@ -1503,9 +1464,7 @@ TclCompileIfCmd(interp, parsePtr, envPtr)
/*
* Compile the else command body.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [wordIdx];
-#endif
+ SetLineInformation (wordIdx);
code = TclCompileCmdWord(interp, tokenPtr+1,
tokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -1617,15 +1576,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
int simpleVarName, isScalar, localIndex, haveImmValue, immValue;
int code = TCL_OK;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if ((parsePtr->numWords != 2) && (parsePtr->numWords != 3)) {
Tcl_ResetResult(interp);
@@ -1637,14 +1588,9 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr,
+ code = TclPushVarNameWord(interp, varTokenPtr, envPtr,
(TCL_NO_LARGE_INDEX | TCL_CREATE_VAR),
-#ifndef TCL_TIP280
- &localIndex, &simpleVarName, &isScalar);
-#else
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ &localIndex, &simpleVarName, &isScalar, 1);
if (code != TCL_OK) {
goto done;
}
@@ -1684,9 +1630,7 @@ TclCompileIncrCmd(interp, parsePtr, envPtr)
TclRegisterNewLiteral(envPtr, word, numBytes), envPtr);
}
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, incrTokenPtr+1,
incrTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -1779,15 +1723,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
int simpleVarName, isScalar, localIndex, numWords;
int code = TCL_OK;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* If we're not in a procedure, don't compile.
@@ -1821,13 +1757,8 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-#ifndef TCL_TIP280
- &localIndex, &simpleVarName, &isScalar);
-#else
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
if (code != TCL_OK) {
goto done;
}
@@ -1843,9 +1774,7 @@ TclCompileLappendCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -1923,15 +1852,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
Tcl_Token *varTokenPtr;
int code, i;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
int numWords;
numWords = parsePtr->numWords;
@@ -1957,9 +1878,7 @@ TclCompileLindexCmd(interp, parsePtr, envPtr)
TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2013,15 +1932,7 @@ TclCompileListCmd(interp, parsePtr, envPtr)
* command created by Tcl_ParseCommand. */
CompileEnv *envPtr; /* Holds resulting instructions. */
{
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* If we're not in a procedure, don't compile.
@@ -2052,9 +1963,7 @@ TclCompileListCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
valueTokenPtr[1].start, valueTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2100,15 +2009,7 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
Tcl_Token *varTokenPtr;
int code;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if (parsePtr->numWords != 2) {
Tcl_SetResult(interp, "wrong # args: should be \"llength list\"",
@@ -2126,9 +2027,7 @@ TclCompileLlengthCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2204,15 +2103,7 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
int i;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/* Check argument count */
@@ -2231,13 +2122,8 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- result = TclPushVarName( interp, varTokenPtr, envPtr,
-#ifndef TCL_TIP280
- TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar );
-#else
- TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ result = TclPushVarNameWord( interp, varTokenPtr, envPtr,
+ TCL_CREATE_VAR, &localIndex, &simpleVarName, &isScalar, 1);
if (result != TCL_OK) {
return result;
}
@@ -2256,9 +2142,7 @@ TclCompileLsetCmd( interp, parsePtr, envPtr )
TclEmitPush(TclRegisterNewLiteral( envPtr, varTokenPtr[1].start,
varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
result = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if ( result != TCL_OK ) {
@@ -2389,15 +2273,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
int i, len, code, nocase, anchorLeft, anchorRight, start;
char *str;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* We are only interested in compiling simple regexp cases.
@@ -2546,9 +2422,7 @@ TclCompileRegexpCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [parsePtr->numWords-1];
-#endif
+ SetLineInformation (parsePtr->numWords-1);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2599,15 +2473,7 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
int code;
int index = envPtr->exceptArrayNext - 1;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
/*
* If we're not in a procedure, don't compile.
@@ -2666,9 +2532,7 @@ TclCompileReturnCmd(interp, parsePtr, envPtr)
* "return" will be byte-compiled; otherwise it will be
* out line compiled.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2729,15 +2593,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
int isAssignment, isScalar, simpleVarName, localIndex, numWords;
int code = TCL_OK;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
numWords = parsePtr->numWords;
if ((numWords != 2) && (numWords != 3)) {
@@ -2759,13 +2615,8 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
varTokenPtr = parsePtr->tokenPtr
+ (parsePtr->tokenPtr->numComponents + 1);
- code = TclPushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
-#ifndef TCL_TIP280
- &localIndex, &simpleVarName, &isScalar);
-#else
- &localIndex, &simpleVarName, &isScalar,
- mapPtr->loc [eclIndex].line [1]);
-#endif
+ code = TclPushVarNameWord(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ &localIndex, &simpleVarName, &isScalar, 1);
if (code != TCL_OK) {
goto done;
}
@@ -2780,9 +2631,7 @@ TclCompileSetCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr, valueTokenPtr[1].start,
valueTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, valueTokenPtr+1,
valueTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2885,15 +2734,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
STR_WORDEND, STR_WORDSTART
};
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if (parsePtr->numWords < 2) {
/* Fail at run time, not in compilation */
@@ -2956,9 +2797,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -2989,9 +2828,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr,
varTokenPtr[1].start, varTokenPtr[1].size), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -3022,9 +2859,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(TclRegisterNewLiteral(envPtr, buf, len), envPtr);
return TCL_OK;
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -3082,9 +2917,7 @@ TclCompileStringCmd(interp, parsePtr, envPtr)
TclEmitPush(
TclRegisterNewLiteral(envPtr, str, length), envPtr);
} else {
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [i];
-#endif
+ SetLineInformation (i);
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
if (code != TCL_OK) {
@@ -3201,15 +3034,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
Tcl_Obj *boolObj;
int boolVal;
-#ifdef TCL_TIP280
- /* TIP #280 : Remember the per-word line information of the current
- * command. An index is used instead of a pointer as recursive compilation
- * may reallocate, i.e. move, the array. This is also the reason to save
- * the nuloc now, it may change during the course of the function.
- */
- ExtCmdLoc* mapPtr = envPtr->extCmdMapPtr;
- int eclIndex = mapPtr->nuloc - 1;
-#endif
+ DefineLineInformation;
if (parsePtr->numWords != 3) {
Tcl_ResetResult(interp);
@@ -3296,9 +3121,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
* Compile the loop body.
*/
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [2];
-#endif
+ SetLineInformation (2);
bodyCodeOffset = (envPtr->codeNext - envPtr->codeStart);
code = TclCompileCmdWord(interp, bodyTokenPtr+1,
bodyTokenPtr->numComponents, envPtr);
@@ -3328,9 +3151,7 @@ TclCompileWhileCmd(interp, parsePtr, envPtr)
testCodeOffset += 3;
}
envPtr->currStackDepth = savedStackDepth;
-#ifdef TCL_TIP280
- envPtr->line = mapPtr->loc [eclIndex].line [1];
-#endif
+ SetLineInformation (1);
code = TclCompileExprWords(interp, testTokenPtr, 1, envPtr);
if (code != TCL_OK) {
if (code == TCL_ERROR) {
@@ -3406,7 +3227,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
#ifndef TCL_TIP280
simpleVarNamePtr, isScalarPtr)
#else
- simpleVarNamePtr, isScalarPtr, line)
+ simpleVarNamePtr, isScalarPtr, line, clNext)
#endif
Tcl_Interp *interp; /* Used for error reporting. */
Tcl_Token *varTokenPtr; /* Points to a variable token. */
@@ -3418,6 +3239,7 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
int *isScalarPtr; /* must not be NULL */
#ifdef TCL_TIP280
int line; /* line the token starts on */
+ int* clNext;
#endif
{
register CONST char *p;
@@ -3601,7 +3423,8 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
if (elName != NULL) {
if (elNameChars) {
#ifdef TCL_TIP280
- envPtr->line = line;
+ envPtr->line = line;
+ envPtr->clNext = clNext;
#endif
code = TclCompileTokens(interp, elemTokenPtr,
elemTokenCount, envPtr);
@@ -3618,7 +3441,8 @@ TclPushVarName(interp, varTokenPtr, envPtr, flags, localIndexPtr,
*/
#ifdef TCL_TIP280
- envPtr->line = line;
+ envPtr->line = line;
+ envPtr->clNext = clNext;
#endif
code = TclCompileTokens(interp, varTokenPtr+1,
varTokenPtr->numComponents, envPtr);
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index b6d486e..aa25f26 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.43.2.15 2009/07/14 16:31:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.43.2.16 2009/08/25 20:59:10 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -307,7 +307,7 @@ static int SetByteCodeFromAny _ANSI_ARGS_((Tcl_Interp *interp,
static void EnterCmdWordData _ANSI_ARGS_((
ExtCmdLoc *eclPtr, int srcOffset, Tcl_Token* tokenPtr,
CONST char* cmd, int len, int numWords, int line,
- int** lines));
+ int* clNext, int** lines, CompileEnv* envPtr));
#endif
@@ -367,7 +367,9 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
register int i;
int length, nested, result;
char *string;
-
+#ifdef TCL_TIP280
+ ContLineLoc* clLocPtr;
+#endif
#ifdef TCL_COMPILE_DEBUG
if (!traceInitialized) {
if (Tcl_LinkVar(interp, "tcl_traceCompile",
@@ -396,6 +398,24 @@ TclSetByteCodeFromAny(interp, objPtr, hookProc, clientData)
TclInitCompileEnv(interp, &compEnv, string, 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);
+ }
#endif
result = TclCompileScript(interp, string, length, nested, &compEnv);
@@ -872,6 +892,15 @@ TclInitCompileEnv(interp, envPtr, string, numBytes, invoker, word)
/* ctx going out of scope */
}
+
+ /*
+ * 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;
#endif
envPtr->auxDataArrayPtr = envPtr->staticAuxDataArraySpace;
@@ -921,6 +950,17 @@ TclFreeCompileEnv(envPtr)
if (envPtr->mallocedAuxDataArray) {
ckfree((char *) envPtr->auxDataArrayPtr);
}
+#ifdef TCL_TIP280
+ /*
+ * 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);
+ }
+#endif
}
#ifdef TCL_TIP280
@@ -1030,6 +1070,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
ExtCmdLoc* eclPtr = envPtr->extCmdMapPtr;
int* wlines;
int wlineat, cmdLine;
+ int* clNext;
#endif
Tcl_DStringInit(&ds);
@@ -1050,6 +1091,7 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
gotParse = 0;
#ifdef TCL_TIP280
cmdLine = envPtr->line;
+ clNext = envPtr->clNext;
#endif
do {
@@ -1169,10 +1211,13 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* 'wlines'.
*/
- TclAdvanceLines (&cmdLine, p, parse.commandStart);
+ TclAdvanceLines (&cmdLine, p, parse.commandStart);
+ TclAdvanceContinuations (&cmdLine, &clNext,
+ parse.commandStart - envPtr->source);
EnterCmdWordData (eclPtr, (parse.commandStart - envPtr->source),
- parse.tokenPtr, parse.commandStart, parse.commandSize,
- parse.numWords, cmdLine, &wlines);
+ parse.tokenPtr, parse.commandStart,
+ parse.commandSize, parse.numWords,
+ cmdLine, clNext, &wlines, envPtr);
wlineat = eclPtr->nuloc - 1;
#endif
@@ -1180,7 +1225,8 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
wordIdx < parse.numWords;
wordIdx++, tokenPtr += (tokenPtr->numComponents + 1)) {
#ifdef TCL_TIP280
- envPtr->line = eclPtr->loc [wlineat].line [wordIdx];
+ envPtr->line = eclPtr->loc [wlineat].line [wordIdx];
+ envPtr->clNext = eclPtr->loc [wlineat].next [wordIdx];
#endif
if (tokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
/*
@@ -1268,6 +1314,13 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
objIndex = TclRegisterNewLiteral(envPtr,
tokenPtr[1].start, tokenPtr[1].size);
+#ifdef TCL_TIP280
+ if (envPtr->clNext) {
+ TclContinuationsEnterDerived (envPtr->literalArrayPtr[objIndex].objPtr,
+ tokenPtr[1].start - envPtr->source,
+ eclPtr->loc [wlineat].next [wordIdx]);
+ }
+#endif
}
TclEmitPush(objIndex, envPtr);
} else {
@@ -1320,7 +1373,9 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
* the reduced form now
*/
ckfree ((char*) eclPtr->loc [wlineat].line);
- eclPtr->loc [wlineat].line = wlines;
+ ckfree ((char*) eclPtr->loc [wlineat].next);
+ eclPtr->loc [wlineat].line = wlines;
+ eclPtr->loc [wlineat].next = NULL;
#endif
} /* end if parse.numWords > 0 */
@@ -1333,7 +1388,8 @@ TclCompileScript(interp, script, numBytes, nested, envPtr)
p = next;
#ifdef TCL_TIP280
/* TIP #280 : Track lines in the just compiled command */
- TclAdvanceLines (&cmdLine, parse.commandStart, p);
+ TclAdvanceLines (&cmdLine, parse.commandStart, p);
+ TclAdvanceContinuations (&cmdLine, &clNext, p - envPtr->source);
#endif
Tcl_FreeParse(&parse);
gotParse = 0;
@@ -1440,6 +1496,43 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
int numObjsToConcat, nameBytes, localVarName, localVar;
int length, i, code;
unsigned char *entryCodeNext = envPtr->codeNext;
+#ifdef TCL_TIP280
+#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));
+ }
+#endif
Tcl_DStringInit(&textBuffer);
numObjsToConcat = 0;
@@ -1454,6 +1547,38 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
length = Tcl_UtfBackslash(tokenPtr->start, (int *) NULL,
buffer);
Tcl_DStringAppend(&textBuffer, buffer, length);
+
+#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 = Tcl_DStringLength (&textBuffer);
+
+ if (numCL >= maxNumCL) {
+ maxNumCL *= 2;
+ clPosition = (int*) ckrealloc ((char*)clPosition,
+ maxNumCL*sizeof(int));
+ }
+ clPosition[numCL] = clPos;
+ numCL ++;
+ }
+ }
+#endif
break;
case TCL_TOKEN_COMMAND:
@@ -1470,6 +1595,13 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
TclEmitPush(literal, envPtr);
numObjsToConcat++;
Tcl_DStringFree(&textBuffer);
+#ifdef TCL_TIP280
+ if (numCL) {
+ TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ numCL, clPosition);
+ }
+ numCL = 0;
+#endif
}
code = TclCompileScript(interp, tokenPtr->start+1,
@@ -1594,6 +1726,14 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
Tcl_DStringLength(&textBuffer), /*onHeap*/ 0);
TclEmitPush(literal, envPtr);
numObjsToConcat++;
+
+#ifdef TCL_TIP280
+ if (numCL) {
+ TclContinuationsEnter(envPtr->literalArrayPtr[literal].objPtr,
+ numCL, clPosition);
+ }
+ numCL = 0;
+#endif
}
/*
@@ -1616,11 +1756,20 @@ TclCompileTokens(interp, tokenPtr, count, envPtr)
TclEmitPush(TclRegisterLiteral(envPtr, "", 0, /*onHeap*/ 0),
envPtr);
}
- Tcl_DStringFree(&textBuffer);
- return TCL_OK;
+ code = TCL_OK;
error:
Tcl_DStringFree(&textBuffer);
+#ifdef TCL_TIP280
+ /*
+ * Release the temp table we used to collect the locations of
+ * continuation lines, if any.
+ */
+
+ if (maxNumCL) {
+ ckfree ((char*) clPosition);
+ }
+#endif
return code;
}
@@ -2426,7 +2575,7 @@ EnterCmdExtentData(envPtr, cmdIndex, numSrcBytes, numCodeBytes)
*/
static void
-EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines)
+EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, clNext, wlines, envPtr)
ExtCmdLoc *eclPtr; /* Points to the map environment
* structure in which to enter command
* location information. */
@@ -2436,12 +2585,15 @@ EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines)
int len;
int numWords;
int line;
+ int* clNext;
int** wlines;
+ CompileEnv* envPtr;
{
ECL* ePtr;
int wordIdx;
CONST char* last;
int wordLine;
+ int* wordNext;
int* wwlines;
if (eclPtr->nuloc >= eclPtr->nloc) {
@@ -2475,19 +2627,24 @@ EnterCmdWordData(eclPtr, srcOffset, tokenPtr, cmd, len, numWords, line, wlines)
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)
? wordLine
: -1);
ePtr->line [wordIdx] = wordLine;
+ ePtr->next [wordIdx] = wordNext;
last = tokenPtr->start;
}
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b3431f8..37b8295 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.33.2.7 2009/07/14 16:31:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.33.2.8 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#ifndef _TCLCOMPILATION
@@ -139,6 +139,7 @@ typedef struct ECL {
int srcOffset; /* cmd location to find the entry */
int nline; /* Number of words in the command */
int* line; /* line information for all words in the command */
+ int** next; /* Transient information during compile, ICL tracking */
} ECL;
typedef struct ExtCmdLoc {
@@ -307,6 +308,13 @@ typedef struct CompileEnv {
int line; /* First line of the script, based on the
* invoking context, then the line of the
* command currently compiled. */
+ 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. */
#endif
} CompileEnv;
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 8dcf877..78e823a 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.94.2.29 2009/07/14 16:31:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.94.2.30 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1580,7 +1580,7 @@ TclExecuteByteCode(interp, codePtr)
*/
#ifdef TCL_TIP280
- bcFrame.data.tebc.pc = pc;
+ bcFrame.data.tebc.pc = (char*) pc;
iPtr->cmdFramePtr = &bcFrame;
TclArgumentBCEnter((Tcl_Interp*) iPtr, objv, objc,
codePtr, &bcFrame,
@@ -4835,7 +4835,7 @@ TclGetSrcInfoForPc (cfPtr)
ByteCode* codePtr = (ByteCode*) cfPtr->data.tebc.codePtr;
if (cfPtr->cmd.str.cmd == NULL) {
- cfPtr->cmd.str.cmd = GetSrcInfoForPc((char*) cfPtr->data.tebc.pc,
+ cfPtr->cmd.str.cmd = GetSrcInfoForPc((unsigned char*) cfPtr->data.tebc.pc,
codePtr,
&cfPtr->cmd.str.len);
}
diff --git a/generic/tclInt.h b/generic/tclInt.h
index fc56e6e..e80f0d4 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.118.2.34 2009/07/14 16:31:49 andreas_kupries Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.118.2.35 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#ifndef _TCLINT
@@ -923,6 +923,37 @@ typedef struct CFWordBC {
int word; /* Index of word in ExtCmdLoc.loc[cmd]->{line,literal}[.] */
struct CFWordBC* prevPtr;
} 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
+ * EvalTokensStandard() in the file "tclBasic.c" and its caller EvalEx(), 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 CLL_END is put after the last
+ * location, as end-marker/sentinel. */
+} ContLineLoc;
+
#endif /* TCL_TIP280 */
/*
@@ -1531,6 +1562,16 @@ typedef struct Interp {
* 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.
+ */
#endif
#ifdef TCL_TIP268
/*
@@ -1848,6 +1889,16 @@ extern char tclEmptyString;
#ifdef TCL_TIP280
EXTERN void TclAdvanceLines _ANSI_ARGS_((int* line, CONST char* start,
CONST char* end));
+EXTERN void TclAdvanceContinuations _ANSI_ARGS_((int* line, int** next,
+ int loc));
+EXTERN ContLineLoc* TclContinuationsEnter _ANSI_ARGS_((Tcl_Obj* objPtr, int num,
+ int* loc));
+EXTERN void TclContinuationsEnterDerived _ANSI_ARGS_((Tcl_Obj* objPtr,
+ int start, int* clNext));
+EXTERN ContLineLoc* TclContinuationsGet _ANSI_ARGS_((Tcl_Obj* objPtr));
+
+EXTERN void TclContinuationsCopy _ANSI_ARGS_((Tcl_Obj* objPtr, Tcl_Obj* originObjPtr));
+
#endif
EXTERN int TclArraySet _ANSI_ARGS_((Tcl_Interp *interp,
Tcl_Obj *arrayNameObj, Tcl_Obj *arrayElemObj));
@@ -2593,4 +2644,11 @@ extern Tcl_Mutex tclObjMutex;
# define TCL_STORAGE_CLASS DLLIMPORT
#endif /* _TCLINT */
-
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
diff --git a/generic/tclObj.c b/generic/tclObj.c
index 16454ac..84d980e 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.42.2.16 2007/10/03 12:53:12 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.42.2.17 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -51,6 +51,38 @@ Tcl_Mutex tclObjMutex;
char tclEmptyString = '\0';
char *tclEmptyStringRep = &tclEmptyString;
+
+#ifdef TCL_TIP280
+/*
+ * 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.
+ */
+} ThreadSpecificData;
+
+static Tcl_ThreadDataKey dataKey;
+
+static void ContLineLocFree _ANSI_ARGS_((char* clientData));
+static void TclThreadFinalizeObjects _ANSI_ARGS_((ClientData clientData));
+static ThreadSpecificData* TclGetContinuationTable _ANSI_ARGS_(());
+#endif
+
/*
* Prototypes for procedures defined later in this file:
*/
@@ -307,6 +339,319 @@ TclFinalizeObjects()
Tcl_MutexUnlock(&tclObjMutex);
}
+#ifdef TCL_TIP280
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclGetContinuationTable --
+ *
+ * This procedure is a helper which returns the thread-specific
+ * hash-table used to track continuation line information associated with
+ * Tcl_Obj*.
+ *
+ * Results:
+ * A reference to the continuation line thread-data.
+ *
+ * Side effects:
+ * May allocate memory for the thread-data.
+ *
+ * TIP #280
+ *----------------------------------------------------------------------
+ */
+
+static ThreadSpecificData*
+TclGetContinuationTable()
+{
+ /*
+ * 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);
+ }
+ 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(objPtr,num,loc)
+ Tcl_Obj* objPtr;
+ int num;
+ int* loc;
+{
+ int newEntry;
+ ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+ 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(objPtr, start, clNext)
+ Tcl_Obj* objPtr;
+ int start;
+ int* clNext;
+{
+ /*
+ * We have to handle invisible continuations lines here as well, despite
+ * the code we have in EvalTokensStandard (ETS) for that. Why ?
+ * Nesting. If our script is the sole argument to an 'eval' command, for
+ * example, the scriptCLLocPtr we are using here was generated by a
+ * previous call to ETS, and while the words we have here may contain
+ * continuation lines they are invisible already, and the call to ETS
+ * above 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 = TclGetContinuationTable();
+ 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(objPtr)
+ Tcl_Obj* objPtr;
+{
+ ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+ 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 clientData;
+{
+ /*
+ * Release the hashtable tracking invisible continuation lines.
+ */
+
+ Tcl_HashEntry *hPtr;
+ Tcl_HashSearch hSearch;
+ ThreadSpecificData *tsdPtr = TclGetContinuationTable();
+
+ 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 (clientData)
+ char* clientData;
+{
+ ckfree (clientData);
+}
+#endif
/*
*--------------------------------------------------------------
*
@@ -700,6 +1045,29 @@ TclFreeObj(objPtr)
Tcl_MutexUnlock(&tclObjMutex);
#endif /* TCL_MEM_DEBUG */
+#ifdef TCL_TIP280
+ /*
+ * 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
TclIncrObjsFreed();
}
@@ -3280,3 +3648,12 @@ SetCmdNameFromAny(interp, objPtr)
objPtr->typePtr = &tclCmdNameType;
return TCL_OK;
}
+
+/*
+ * Local Variables:
+ * mode: c
+ * c-basic-offset: 4
+ * fill-column: 78
+ * End:
+ */
+
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 1e9f6b4..8ceb184 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.44.2.10 2009/06/13 14:38:44 dgp Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.44.2.11 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -366,8 +366,20 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
*/
if (Tcl_IsShared(bodyPtr)) {
+#ifdef TCL_TIP280
+ Tcl_Obj* sharedBodyPtr = bodyPtr;
+#endif
bytes = Tcl_GetStringFromObj(bodyPtr, &length);
bodyPtr = Tcl_NewStringObj(bytes, length);
+#ifdef TCL_TIP280
+ /*
+ * 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);
+#endif
}
/*
diff --git a/generic/tclVar.c b/generic/tclVar.c
index b29400e..78505ff 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.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: tclVar.c,v 1.69.2.14 2007/05/10 18:23:58 dgp Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.69.2.15 2009/08/25 20:59:11 andreas_kupries Exp $
*/
#include "tclInt.h"
@@ -1659,6 +1659,15 @@ TclPtrSetVar(interp, varPtr, arrayPtr, part1, part2, newValuePtr, flags)
} else {
if (Tcl_IsShared(oldValuePtr)) { /* append to copy */
varPtr->value.objPtr = Tcl_DuplicateObj(oldValuePtr);
+#ifdef TCL_TIP280
+ /*
+ * 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);
+#endif
TclDecrRefCount(oldValuePtr);
oldValuePtr = varPtr->value.objPtr;
Tcl_IncrRefCount(oldValuePtr); /* since var is ref */