Attachment "patch-a09031e288-quickfix.diff-c50-w" to
ticket [a09031e288]
added by
leon
2018-12-10 20:21:09.
Index: generic/tclObj.c
==================================================================
--- generic/tclObj.c
+++ generic/tclObj.c
@@ -51,101 +51,101 @@
char tclEmptyString = '\0';
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
/*
* Structure for tracking the source file and line number where a given
* Tcl_Obj was allocated. We also track the pointer to the Tcl_Obj itself,
* for sanity checking purposes.
*/
typedef struct {
Tcl_Obj *objPtr; /* The pointer to the allocated Tcl_Obj. */
const char *file; /* The name of the source file calling this
* function; used for debugging. */
int line; /* Line number in the source file; used for
* debugging. */
} ObjData;
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
/*
* 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 {
Tcl_HashTable *lineCLPtr; /* This table remembers for each Tcl_Obj
* generated by a call to the function
* TclSubstTokens() from a literal text
* where bs+nl sequences occured in it, if
* any. I.e. this table keeps track of
* invisible and 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 TCL_THREADS && defined(TCL_MEM_DEBUG)
Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
* that a Tcl_Obj was not allocated by some
* other thread. */
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
static void TclThreadFinalizeContLines(ClientData clientData);
-static ThreadSpecificData *TclGetContLineTable(void);
+static Tcl_HashTable *TclGetContLineTable(void);
/*
* Nested Tcl_Obj deletion management support
*
* All context references used in the object freeing code are pointers to this
* structure; every thread will have its own structure instance. The purpose
* of this structure is to allow deeply nested collections of Tcl_Objs to be
* freed without taking a vast depth of C stack (which could cause all sorts
* of breakage.)
*/
typedef struct PendingObjData {
int deletionCount; /* Count of the number of invokations of
* TclFreeObj() are on the stack (at least
* conceptually; many are actually expanded
* macros). */
Tcl_Obj *deletionStack; /* Stack of objects that have had TclFreeObj()
* invoked upon them but which can't be
* deleted yet because they are in a nested
* invokation of TclFreeObj(). By postponing
* this way, we limit the maximum overall C
* stack depth when deleting a complex object.
* The down-side is that we alter the overall
* behaviour by altering the order in which
* objects are deleted, and we change the
* order in which the string rep and the
* internal rep of an object are deleted. Note
* that code which assumes the previous
* behaviour in either of these respects is
* unsafe anyway; it was never documented as
* to exactly what would happen in these
* cases, and the overall contract of a
* user-level Tcl_DecrRefCount() is still
* preserved (assuming that a particular T_DRC
* would delete an object is not very
* safe). */
} PendingObjData;
/*
* These are separated out so that some semantic content is attached
* to them.
*/
#define ObjDeletionLock(contextPtr) ((contextPtr)->deletionCount++)
#define ObjDeletionUnlock(contextPtr) ((contextPtr)->deletionCount--)
#define ObjDeletePending(contextPtr) ((contextPtr)->deletionCount > 0)
#define ObjOnStack(contextPtr) ((contextPtr)->deletionStack != NULL)
#define PushObjToDelete(contextPtr,objPtr) \
/* The string rep is already invalidated so we can use the bytes value \
* for our pointer chain: push onto the head of the stack. */ \
(objPtr)->bytes = (char *) ((contextPtr)->deletionStack); \
@@ -435,166 +435,212 @@
}
}
Tcl_DeleteHashTable(tablePtr);
Tcl_Free(tablePtr);
tsdPtr->objThreadMap = NULL;
}
#endif
}
/*
*----------------------------------------------------------------------
*
* TclFinalizeObjects --
*
* This function is called by Tcl_Finalize to clean up all registered
* Tcl_ObjType's and to reset the tclFreeObjList.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
void
TclFinalizeObjects(void)
{
Tcl_MutexLock(&tableMutex);
if (typeTableInitialized) {
Tcl_DeleteHashTable(&typeTable);
typeTableInitialized = 0;
}
Tcl_MutexUnlock(&tableMutex);
/*
* All we do here is reset the head pointer of the linked list of free
* Tcl_Obj's to NULL; the memory finalization will take care of releasing
* memory for us.
*/
Tcl_MutexLock(&tclObjMutex);
tclFreeObjList = NULL;
Tcl_MutexUnlock(&tclObjMutex);
}
/*
*----------------------------------------------------------------------
*
+ * Bookkeeping of line continuation (backslash+newline) sequences with
+ * the purpose of reporting correct line numbers in the result of
+ * [info frame level] introduces noticeable overhead in TclFreeObj().
+ * Therefore that functionality can be turned on or off via the
+ * environment variable TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS
+ * (setting it to 0 results in improved performance at the cost of
+ * worse debuggability of Tcl scripts, while any other value has an
+ * opposite effect). During compilation, defining a macro with the same
+ * name sets the default value for that setting.
+ *
+ *----------------------------------------------------------------------
+ */
+
+#ifndef TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS
+#define TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS 1
+#endif
+
+static int infoFrameMustReportAccurateLineNumbers(void)
+{
+ const char* v = getenv("TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS");
+ return v == NULL
+ ? TCL_INFO_FRAME_ENABLE_ACCURATE_LINE_NUMBERS
+ : strcmp(v, "0") != 0;
+}
+
+static int lineContinuationsMustBeTracked(void)
+{
+ static int x = -1;
+ if ( x == -1 )
+ x = (infoFrameMustReportAccurateLineNumbers() != 0);
+ return x;
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
* TclGetContLineTable --
*
* 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 *
+static Tcl_HashTable *
TclGetContLineTable(void)
{
+ ThreadSpecificData *tsdPtr;
+
+ if ( ! lineContinuationsMustBeTracked() )
+ return NULL;
+
/*
* 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);
+ tsdPtr = TCL_TSD_INIT(&dataKey);
if (!tsdPtr->lineCLPtr) {
tsdPtr->lineCLPtr = Tcl_Alloc(sizeof(Tcl_HashTable));
Tcl_InitHashTable(tsdPtr->lineCLPtr, TCL_ONE_WORD_KEYS);
Tcl_CreateThreadExitHandler(TclThreadFinalizeContLines,NULL);
}
- return tsdPtr;
+ return tsdPtr->lineCLPtr;
}
/*
*----------------------------------------------------------------------
*
* 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 = TclGetContLineTable();
- Tcl_HashEntry *hPtr =
- Tcl_CreateHashEntry(tsdPtr->lineCLPtr, objPtr, &newEntry);
- ContLineLoc *clLocPtr = Tcl_Alloc(sizeof(ContLineLoc) + num*sizeof(int));
+ Tcl_HashEntry *hPtr;
+ ContLineLoc *clLocPtr;
+
+ Tcl_HashTable *contLineTable = TclGetContLineTable();
+ if ( ! contLineTable )
+ return NULL;
+
+ hPtr = Tcl_CreateHashEntry(contLineTable, objPtr, &newEntry);
+ clLocPtr = Tcl_Alloc(sizeof(ContLineLoc) + num*sizeof(int));
if (!newEntry) {
/*
* We're entering ContLineLoc data for the same value more than one
* time. Taking care not to leak the old entry.
*
* This can happen when literals in a proc body are shared. See for
* example test info-30.19 where the action (code) for all branches of
* the switch command is identical, mapping them all to the same
* literal. An interesting result of this is that the number and
* locations (offset) of invisible continuation lines in the literal
* are the same for all occurences.
*
* Note that while reusing the existing entry is possible it requires
* the same actions as for a new entry because we have to copy the
* incoming num/loc data even so. Because we are called from
* TclContinuationsEnterDerived for this case, which modified the
* stored locations (Rebased to the proper relative offset). Just
* returning the stored entry would rebase them a second time, or
* more, hosing the data. It is easier to simply replace, as we are
* doing.
*/
Tcl_Free(Tcl_GetHashValue(hPtr));
}
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
@@ -653,183 +699,195 @@
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 = TclGetContLineTable();
- Tcl_HashEntry *hPtr =
- Tcl_FindHashEntry(tsdPtr->lineCLPtr, originObjPtr);
+ Tcl_HashEntry *hPtr;
+ Tcl_HashTable *contLineTable = TclGetContLineTable();
+ if ( ! contLineTable )
+ return;
+
+ hPtr = Tcl_FindHashEntry(contLineTable, originObjPtr);
if (hPtr) {
ContLineLoc *clLocPtr = 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 = TclGetContLineTable();
- Tcl_HashEntry *hPtr =
- Tcl_FindHashEntry(tsdPtr->lineCLPtr, objPtr);
+ Tcl_HashEntry *hPtr;
+ Tcl_HashTable *contLineTable = TclGetContLineTable();
+ if ( ! contLineTable )
+ return NULL;
+
+ hPtr = Tcl_FindHashEntry(contLineTable, objPtr);
if (!hPtr) {
return NULL;
}
return Tcl_GetHashValue(hPtr);
}
/*
*----------------------------------------------------------------------
*
* TclThreadFinalizeContLines --
*
* 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
TclThreadFinalizeContLines(
ClientData clientData)
{
/*
* Release the hashtable tracking invisible continuation lines.
*/
- ThreadSpecificData *tsdPtr = TclGetContLineTable();
Tcl_HashEntry *hPtr;
Tcl_HashSearch hSearch;
- for (hPtr = Tcl_FirstHashEntry(tsdPtr->lineCLPtr, &hSearch);
+ Tcl_HashTable *contLineTable = TclGetContLineTable();
+ if ( ! contLineTable )
+ return;
+
+ for (hPtr = Tcl_FirstHashEntry(contLineTable, &hSearch);
hPtr != NULL; hPtr = Tcl_NextHashEntry(&hSearch)) {
Tcl_Free(Tcl_GetHashValue(hPtr));
Tcl_DeleteHashEntry(hPtr);
}
- Tcl_DeleteHashTable(tsdPtr->lineCLPtr);
- Tcl_Free(tsdPtr->lineCLPtr);
+ Tcl_DeleteHashTable(contLineTable);
+ Tcl_Free(contLineTable);
+ {
+ ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
tsdPtr->lineCLPtr = NULL;
}
+}
/*
*--------------------------------------------------------------
*
* Tcl_RegisterObjType --
*
* This function is called to register a new Tcl object type in the table
* of all object types supported by Tcl.
*
* Results:
* None.
*
* Side effects:
* The type is registered in the Tcl type table. If there was already a
* type with the same name as in typePtr, it is replaced with the new
* type.
*
*--------------------------------------------------------------
*/
void
Tcl_RegisterObjType(
const Tcl_ObjType *typePtr) /* Information about object type; storage must
* be statically allocated (must live
* forever). */
{
int isNew;
Tcl_MutexLock(&tableMutex);
Tcl_SetHashValue(
Tcl_CreateHashEntry(&typeTable, typePtr->name, &isNew), typePtr);
Tcl_MutexUnlock(&tableMutex);
}
/*
*----------------------------------------------------------------------
*
* Tcl_AppendAllObjTypes --
*
* This function appends onto the argument object the name of each object
* type as a list element. This includes the builtin object types (e.g.
* int, list) as well as those added using Tcl_NewObj. These names can be
* used, for example, with Tcl_GetObjType to get pointers to the
* corresponding Tcl_ObjType structures.
*
* Results:
* The return value is normally TCL_OK; in this case the object
* referenced by objPtr has each type name appended to it. If an error
* occurs, TCL_ERROR is returned and the interpreter's result holds an
* error message.
