diff options
author | andreas_kupries <akupries@shaw.ca> | 2009-08-25 21:03:25 (GMT) |
---|---|---|
committer | andreas_kupries <akupries@shaw.ca> | 2009-08-25 21:03:25 (GMT) |
commit | 130082d57a8eecf64d27adcb53065841cffae765 (patch) | |
tree | 6a35012c7976983d9ac4f9388eccea03ae9f4fed /generic/tclObj.c | |
parent | 875ca13780241d27fe74f005232bd5201ed4433b (diff) | |
download | tcl-130082d57a8eecf64d27adcb53065841cffae765.zip tcl-130082d57a8eecf64d27adcb53065841cffae765.tar.gz tcl-130082d57a8eecf64d27adcb53065841cffae765.tar.bz2 |
* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard,
Tcl_EvalEx, TclEvalEx, TclAdvanceContinuations, TclNREvalObjEx):
* generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines):
* generic/tclCompCmds.c (*):
* generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv,
TclFreeCompileEnv, TclCompileScript, TclCompileTokens):
* 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 the parser, compiler, and execution engine with code and
attendant data structures tracking the position of continuation
lines which are not visible in the resulting script Tcl_Obj*'s, to
properly account for them while counting lines for #280.
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r-- | generic/tclObj.c | 400 |
1 files changed, 389 insertions, 11 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c index 8052028..0bdb371 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.155 2009/08/12 16:06:44 dgp Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.156 2009/08/25 21:03:25 andreas_kupries Exp $ */ #include "tclInt.h" @@ -68,18 +68,45 @@ typedef struct ObjData { int line; /* Line number in the source file; used for * debugging. */ } ObjData; - +#endif /* TCL_MEM_DEBUG && 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 @@ -428,7 +455,7 @@ TclFinalizeThreadObjects(void) #if defined(TCL_MEM_DEBUG) && defined(TCL_THREADS) Tcl_HashEntry *hPtr; Tcl_HashSearch hSearch; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TclGetTables(); Tcl_HashTable *tablePtr = tsdPtr->objThreadMap; if (tablePtr != NULL) { @@ -486,6 +513,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 -- @@ -677,7 +1011,7 @@ TclDbDumpActiveObjects( Tcl_HashSearch hSearch; Tcl_HashEntry *hPtr; Tcl_HashTable *tablePtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TclGetTables(); tablePtr = tsdPtr->objThreadMap; @@ -744,7 +1078,7 @@ TclDbInitNewObj( Tcl_HashTable *tablePtr; int isNew; ObjData *objData; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TclGetTables(); if (tsdPtr->objThreadMap == NULL) { tsdPtr->objThreadMap = (Tcl_HashTable *) @@ -1010,6 +1344,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 */ @@ -1075,6 +1431,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 @@ -3267,7 +3645,7 @@ Tcl_DbIncrRefCount( if (!TclInExit()) { Tcl_HashTable *tablePtr; Tcl_HashEntry *hPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TclGetTables(); tablePtr = tsdPtr->objThreadMap; if (!tablePtr) { @@ -3332,7 +3710,7 @@ Tcl_DbDecrRefCount( if (!TclInExit()) { Tcl_HashTable *tablePtr; Tcl_HashEntry *hPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TclGetTables(); tablePtr = tsdPtr->objThreadMap; if (!tablePtr) { @@ -3412,7 +3790,7 @@ Tcl_DbIsShared( if (!TclInExit()) { Tcl_HashTable *tablePtr; Tcl_HashEntry *hPtr; - ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + ThreadSpecificData *tsdPtr = TclGetTables(); tablePtr = tsdPtr->objThreadMap; if (!tablePtr) { Tcl_Panic("object table not initialized"); |