* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard,

	EvalTokensStandard, Tcl_EvalEx, EvalEx, TclAdvanceContinuations,
	TclEvalObjEx):
	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines):
	* generic/tclCompCmds.c (*):
	* generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv,
	TclFreeCompileEnv, TclCompileScript):
	* generic/tclCompile.h (CompileEnv):
	* generic/tclInt.h (ContLineLoc, Interp):
	* generic/tclObj.c (ThreadSpecificData, ContLineLocFree,
	TclThreadFinalizeObjects, TclInitObjSubsystem,
	TclContinuationsEnter, TclContinuationsEnterDerived,
	TclContinuationsCopy, TclContinuationsGet, TclFreeObj):
	* generic/tclParse.c (TclSubstTokens, Tcl_SubstObj):
	* generic/tclProc.c (TclCreateProc):
	* generic/tclVar.c (TclPtrSetVar):
	* tests/info.test (info-30.0-24):

	Extended parser, compiler, and execution with code and attendant
	data structures tracking the positions of continuation lines which
	are not visible in script Tcl_Obj*'s, to properly account for them
	while counting lines for #280.

1 files changed, 383 insertions, 7 deletions

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