From 47bc45a266ba286820335a419034d5521c3c6435 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 26 Sep 2024 21:08:47 +0000 Subject: Backport Tcl_BounceRefCount() from Tcl 9.0 --- changes.md | 2 +- doc/Object.3 | 36 +++++++++++++++++++++++++++++------- generic/tcl.h | 42 ++++++++++++++++++++++++++++++++++++++++++ generic/tclOOBasic.c | 2 +- unix/tclUnixChan.c | 2 +- win/tclWinChan.c | 2 +- 6 files changed, 75 insertions(+), 11 deletions(-) diff --git a/changes.md b/changes.md index 4a0197f..446095c 100644 --- a/changes.md +++ b/changes.md @@ -24,7 +24,7 @@ writing Tcl scripts. core Tcl feature. ## Unix notifiers available using `epoll()` or `kqueue()` - - This relieves limits on file descriptors imposed by legacy `select()` and fixes a performance bottleneck. + - This relieves limits on file descriptors imposed by legacy `select()` and fixes a performance bottleneck. # Incompatibilities diff --git a/doc/Object.3 b/doc/Object.3 index 818ba45..efc3900 100644 --- a/doc/Object.3 +++ b/doc/Object.3 @@ -8,7 +8,7 @@ .so man.macros .BS .SH NAME -Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl values +Tcl_NewObj, Tcl_DuplicateObj, Tcl_IncrRefCount, Tcl_DecrRefCount, Tcl_BounceRefCount, Tcl_IsShared, Tcl_InvalidateStringRep \- manipulate Tcl values .SH SYNOPSIS .nf \fB#include \fR @@ -23,6 +23,8 @@ Tcl_Obj * .sp \fBTcl_DecrRefCount\fR(\fIobjPtr\fR) .sp +\fBTcl_BounceRefCount\fR(\fIobjPtr\fR) +.sp int \fBTcl_IsShared\fR(\fIobjPtr\fR) .sp @@ -295,6 +297,8 @@ new reference to the value is created. The macro \fBTcl_DecrRefCount\fR decrements the count when a reference is no longer needed. If the value's reference count drops to zero, frees its storage. +The macro \fBTcl_BounceRefCount\fR will check if the value has no +references (i.e. in a "new" state) and free the value. A value shared by different code or data structures has \fIrefCount\fR greater than 1. Incrementing a value's reference count ensures that it will not be freed too early or have its value change @@ -312,12 +316,25 @@ the interpreter calls \fBTcl_DecrRefCount\fR to decrement each argument's reference count. When a value's reference count drops less than or equal to zero, \fBTcl_DecrRefCount\fR reclaims its storage. -Most command procedures do not have to be concerned about -reference counting since they use a value's value immediately -and do not retain a pointer to the value after they return. -However, if they do retain a pointer to a value in a data structure, -they must be careful to increment its reference count -since the retained pointer is a new reference. + +.PP +Most command procedures have not been concerned about reference +counting since they use a value immediately and do not retain +a pointer to the value after they return. However, there are some +procedures that may return a new value, with a refCount of 0. In this +situation, it is the caller's responsibility to free the value before +the procedure returns. One way to cover this is to always call +\fBTcl_IncrRefCount\fR before using the value, then call +\fBTcl_DecrRefCount\fR before returning. The other way is to use +\fBTcl_BounceRefCount\fR after the value is no longer needed or +referenced. This macro will free the value if there are no other +references to the value. When retaining a pointer to a value in a data +structure the procedure must be careful to increment its reference +count since the retained pointer is a new reference. Examples of +procedures that return new values are \fBTcl_NewIntObj\fR, and +commands like \fBlseq\fR, which creates an Abstract List, and an +lindex on this list may return a new Obj with a refCount of 0. + .PP Command procedures that directly modify values such as those for \fBlappend\fR and \fBlinsert\fR must be careful to @@ -351,6 +368,11 @@ must check whether the variable's value is shared before incrementing the integer in its internal representation. If it is shared, it needs to duplicate the value in order to avoid accidentally changing values in other data structures. +.PP +In cases where a value is obtained, used, and not retained, the value +can be freed using \fBTcl_BounceRefCount\fR. This +is functionally equivalent to calling \fBTcl_IncrRefCount\fR followed +\fBTcl_DecrRefCount\fR. .SH "SEE ALSO" Tcl_ConvertToType(3), Tcl_GetIntFromObj(3), Tcl_ListObjAppendElement(3), Tcl_ListObjIndex(3), Tcl_ListObjReplace(3), Tcl_RegisterObjType(3) .SH KEYWORDS diff --git a/generic/tcl.h b/generic/tcl.h index 2f3ec17..4b3a36c 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -2588,6 +2588,29 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ Tcl_DbIsShared(objPtr, __FILE__, __LINE__) +/* + * Free the Obj by effectively doing: + * + * Tcl_IncrRefCount(objPtr); + * Tcl_DecrRefCount(objPtr); + * + * This will free the obj if there are no references to the obj. + */ +# define Tcl_BounceRefCount(objPtr) \ + TclBounceRefCount(objPtr, __FILE__, __LINE__) + +static inline void +TclBounceRefCount( + Tcl_Obj* objPtr, + const char* fn, + int line) +{ + if (objPtr) { + if ((objPtr)->refCount == 0) { + Tcl_DbDecrRefCount(objPtr, fn, line); + } + } +} #else # undef Tcl_IncrRefCount # define Tcl_IncrRefCount(objPtr) \ @@ -2607,6 +2630,25 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ ((objPtr)->refCount > 1) + +/* + * Declare that obj will no longer be used or referenced. + * This will free the obj if there are no references to the obj. + */ +# define Tcl_BounceRefCount(objPtr) \ + TclBounceRefCount(objPtr); + +static inline void +TclBounceRefCount( + Tcl_Obj* objPtr) +{ + if (objPtr) { + if ((objPtr)->refCount == 0) { + Tcl_DecrRefCount(objPtr); + } + } +} + #endif /* diff --git a/generic/tclOOBasic.c b/generic/tclOOBasic.c index 5fab092..af19d765 100644 --- a/generic/tclOOBasic.c +++ b/generic/tclOOBasic.c @@ -94,7 +94,7 @@ TclOO_Class_Constructor( /* * Make the class definition delegate. This is special; it doesn't reenter * here (and the class definition delegate doesn't run any constructors). - * + * * This needs to be done before consideration of whether to pass the script * argument to [oo::define]. [Bug 680503] */ diff --git a/unix/tclUnixChan.c b/unix/tclUnixChan.c index 55287cc..0fb6215 100644 --- a/unix/tclUnixChan.c +++ b/unix/tclUnixChan.c @@ -1847,7 +1847,7 @@ TclpOpenFileChannel( if (interp != (Tcl_Interp *) NULL) { /* * We need this just to ensure we return the correct error messages under - * some circumstances (relative paths only), so because the normalization + * some circumstances (relative paths only), so because the normalization * is very expensive, don't invoke it for native or absolute paths. * Note: since paths starting with ~ are absolute, it also considers tilde expansion, * (proper error message of tests *io-40.17 "tilde substitution in open") diff --git a/win/tclWinChan.c b/win/tclWinChan.c index f56ff38..97fd424 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -1087,7 +1087,7 @@ TclpOpenFileChannel( if (interp) { /* * We need this just to ensure we return the correct error messages under - * some circumstances (relative paths only), so because the normalization + * some circumstances (relative paths only), so because the normalization * is very expensive, don't invoke it for native or absolute paths. * Note: since paths starting with ~ are absolute, it also considers tilde expansion, * (proper error message of tests *io-40.17 "tilde substitution in open") -- cgit v0.12