static void
DeleteHistoryObjs(
ClientData clientData,
Tcl_Interp *interp)
{
register HistoryObjs *histObjsPtr = clientData;
TclDecrRefCount(histObjsPtr->historyObj);
TclDecrRefCount(histObjsPtr->addObj);
Tcl_Free(histObjsPtr);
}
static int
DecrRefsPostClassConstructor(
ClientData data[],
Tcl_Interp *interp,
int result)
{
Tcl_Obj **invoke = data[0];
TclDecrRefCount(invoke[0]);
TclDecrRefCount(invoke[1]);
TclDecrRefCount(invoke[2]);
ckfree(invoke);
return result;
}
void
TclReleaseLiteral(
Tcl_Interp *interp, /* Interpreter for which objPtr was created to
* hold a literal. */
register Tcl_Obj *objPtr) /* Points to a literal object that was
* previously created by a call to
* TclRegisterLiteral. */
{
Interp *iPtr = (Interp *) interp;
LiteralTable *globalTablePtr = &(iPtr->literalTable);
register LiteralEntry *entryPtr, *prevPtr;
char *bytes;
int length, index;
bytes = TclGetStringFromObj(objPtr, &length);
index = (HashString(bytes, length) & globalTablePtr->mask);
/*
* Check to see if the object is in the global literal table and remove
* this reference. The object may not be in the table if it is a hidden
* local literal.
*/
for (prevPtr=NULL, entryPtr=globalTablePtr->buckets[index];
entryPtr!=NULL ; prevPtr=entryPtr, entryPtr=entryPtr->nextPtr) {
if (entryPtr->objPtr == objPtr) {
entryPtr->refCount--;
/*
* If the literal is no longer being used by any ByteCode, delete
* the entry then remove the reference corresponding to the global
* literal table entry (decrement the ref count of the object).
*/
if (entryPtr->refCount == 0) {
if (prevPtr == NULL) {
globalTablePtr->buckets[index] = entryPtr->nextPtr;
} else {
prevPtr->nextPtr = entryPtr->nextPtr;
}
ckfree((char *) entryPtr);
globalTablePtr->numEntries--;
TclDecrRefCount(objPtr);
#ifdef TCL_COMPILE_STATS
iPtr->stats.currentLitStringBytes -= (double) (length + 1);
#endif /*TCL_COMPILE_STATS*/
}
break;
}
}
/*
* Remove the reference corresponding to the local literal table entry.
*/
Tcl_DecrRefCount(objPtr);
}
static void
FreeRegexp(
TclRegexp *regexpPtr) /* Compiled regular expression to free. */
{
TclReFree(®expPtr->re);
if (regexpPtr->globObjPtr) {
TclDecrRefCount(regexpPtr->globObjPtr);
}
if (regexpPtr->matches) {
ckfree(regexpPtr->matches);
}
ckfree(regexpPtr);
}
void
TclDeleteLiteralTable(
Tcl_Interp *interp, /* Interpreter containing shared literals
* referenced by the table to delete. */
LiteralTable *tablePtr) /* Points to the literal table to delete. */
{
LiteralEntry *entryPtr, *nextPtr;
Tcl_Obj *objPtr;
int i;
/*
* Release remaining literals in the table. Note that releasing a literal
* might release other literals, modifying the table, so we restart the
* search from the bucket chain we last found an entry.
*/
#ifdef TCL_COMPILE_DEBUG
TclVerifyGlobalLiteralTable((Interp *) interp);
#endif /*TCL_COMPILE_DEBUG*/
/*
* We used to call TclReleaseLiteral for each literal in the table, which
* is rather inefficient as it causes one lookup-by-hash for each
* reference to the literal. We now rely at interp-deletion on each
* bytecode object to release its references to the literal Tcl_Obj
* without requiring that it updates the global table itself, and deal
* here only with the table.
*/
for (i=0 ; i<tablePtr->numBuckets ; i++) {
entryPtr = tablePtr->buckets[i];
while (entryPtr != NULL) {
objPtr = entryPtr->objPtr;
TclDecrRefCount(objPtr);
nextPtr = entryPtr->nextPtr;
ckfree((char *) entryPtr);
entryPtr = nextPtr;
}
}
/*
* Free up the table's bucket array if it was dynamically allocated.
*/
if (tablePtr->buckets != tablePtr->staticBuckets) {
ckfree((char *) tablePtr->buckets);
}
}
int
TclFileTemporaryCmd(
ClientData clientData,
Tcl_Interp *interp,
int objc,
Tcl_Obj *const objv[])
{
Tcl_Obj *nameVarObj = NULL; /* Variable to store the name of the temporary
* file in. */
Tcl_Obj *nameObj = NULL; /* Object that will contain the filename. */
Tcl_Channel chan; /* The channel opened (RDWR) on the temporary
* file, or NULL if there's an error. */
Tcl_Obj *tempDirObj = NULL, *tempBaseObj = NULL, *tempExtObj = NULL;
/* Pieces of template. Each piece is NULL if
* it is omitted. The platform temporary file
* engine might ignore some pieces. */
if (objc < 1 || objc > 3) {
Tcl_WrongNumArgs(interp, 1, objv, "?nameVar? ?template?");
return TCL_ERROR;
}
if (objc > 1) {
nameVarObj = objv[1];
TclNewObj(nameObj);
}
if (objc > 2) {
int length;
Tcl_Obj *templateObj = objv[2];
const char *string = TclGetStringFromObj(templateObj, &length);
/*
* Treat an empty string as if it wasn't there.
*/
if (length == 0) {
goto makeTemporary;
}
/*
* The template only gives a directory if there is a directory
* separator in it.
*/
if (strchr(string, '/') != NULL
|| (tclPlatform == TCL_PLATFORM_WINDOWS
&& strchr(string, '\\') != NULL)) {
tempDirObj = TclPathPart(interp, templateObj, TCL_PATH_DIRNAME);
/*
* Only allow creation of temporary files in the native filesystem
* since they are frequently used for integration with external
* tools or system libraries. [Bug 2388866]
*/
if (tempDirObj != NULL && Tcl_FSGetFileSystemForPath(tempDirObj)
!= &tclNativeFilesystem) {
TclDecrRefCount(tempDirObj);
tempDirObj = NULL;
}
}
/*
* The template only gives the filename if the last character isn't a
* directory separator.
*/
if (string[length-1] != '/' && (tclPlatform != TCL_PLATFORM_WINDOWS
|| string[length-1] != '\\')) {
Tcl_Obj *tailObj = TclPathPart(interp, templateObj,
TCL_PATH_TAIL);
if (tailObj != NULL) {
tempBaseObj = TclPathPart(interp, tailObj, TCL_PATH_ROOT);
tempExtObj = TclPathPart(interp, tailObj, TCL_PATH_EXTENSION);
TclDecrRefCount(tailObj);
}
}
}
/*
* Convert empty parts of the template into unspecified parts.
*/
if (tempDirObj && !TclGetString(tempDirObj)[0]) {
TclDecrRefCount(tempDirObj);
tempDirObj = NULL;
}
if (tempBaseObj && !TclGetString(tempBaseObj)[0]) {
TclDecrRefCount(tempBaseObj);
tempBaseObj = NULL;
}
if (tempExtObj && !TclGetString(tempExtObj)[0]) {
TclDecrRefCount(tempExtObj);
tempExtObj = NULL;
}
/*
* Create and open the temporary file.
*/
makeTemporary:
chan = TclpOpenTemporaryFile(tempDirObj,tempBaseObj,tempExtObj, nameObj);
/*
* If we created pieces of template, get rid of them now.
*/
if (tempDirObj) {
TclDecrRefCount(tempDirObj);
}
if (tempBaseObj) {
TclDecrRefCount(tempBaseObj);
}
if (tempExtObj) {
TclDecrRefCount(tempExtObj);
}
/*
* Deal with results.
*/
if (chan == NULL) {
if (nameVarObj) {
TclDecrRefCount(nameObj);
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"can't create temporary file: %s", Tcl_PosixError(interp)));
return TCL_ERROR;
}
Tcl_RegisterChannel(interp, chan);
if (nameVarObj != NULL) {
if (Tcl_ObjSetVar2(interp, nameVarObj, NULL, nameObj,
TCL_LEAVE_ERR_MSG) == NULL) {
Tcl_UnregisterChannel(interp, chan);
return TCL_ERROR;
}
}
Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1));
return TCL_OK;
}
