From b9378388c856835c67ce13f4f0495ac9f28a48d0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 26 Sep 2024 20:20:34 +0000 Subject: Backport http 2.10.0 from 9.0 --- library/http/http.tcl | 22 +++++++++++----------- library/http/pkgIndex.tcl | 2 +- library/manifest.txt | 2 +- unix/Makefile.in | 4 ++-- win/Makefile.in | 4 ++-- 5 files changed, 17 insertions(+), 17 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index cbbcead..6050ed9 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -11,7 +11,7 @@ package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.10b2 +package provide http 2.10.0 namespace eval http { # Allow resourcing to not clobber existing data @@ -1785,7 +1785,7 @@ proc http::OpenSocket {token DoLater} { fconfigure $sock -translation {auto crlf} \ -buffersize $state(-blocksize) if {[package vsatisfies [package provide Tcl] 9.0-]} { - fconfigure $sock -profile tcl8 + fconfigure $sock -profile replace } ##Log socket opened, DONE fconfigure - token $token } @@ -2206,7 +2206,7 @@ proc http::Connected {token proto phost srvurl} { fconfigure $sock -translation [list $trRead crlf] \ -buffersize $state(-blocksize) if {[package vsatisfies [package provide Tcl] 9.0-]} { - fconfigure $sock -profile tcl8 + fconfigure $sock -profile replace } # The following is disallowed in safe interpreters, but the socket is @@ -2448,7 +2448,7 @@ proc http::Connected {token proto phost srvurl} { if {[info exists state(reusing)] && $state(reusing)} { # The socket was closed at the server end, and closed at # this end by http::CheckEof. - if {[TestForReplay $token write $err a]} { + if {[TestForReplay $token write $err a]} { return } else { Finish $token {failed to re-use socket} @@ -2599,7 +2599,7 @@ proc http::ReceiveResponse {token} { fconfigure $sock -translation [list auto $trWrite] \ -buffersize $state(-blocksize) if {[package vsatisfies [package provide Tcl] 9.0-]} { - fconfigure $sock -profile tcl8 + fconfigure $sock -profile replace } Log ^D$tk begin receiving response - token $token @@ -3395,7 +3395,7 @@ proc http::cleanup {token} { # # Side Effects # Sets the status of the connection, which unblocks -# the waiting geturl call +# the waiting geturl call proc http::Connect {token proto phost srvurl} { variable $token @@ -4593,7 +4593,7 @@ proc http::Eot {token {reason {}}} { set enc [CharsetToEncoding $state(charset)] if {$enc ne "binary"} { if {[package vsatisfies [package provide Tcl] 9.0-]} { - set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)] + set state(body) [encoding convertfrom -profile replace $enc $state(body)] } else { set state(body) [encoding convertfrom $enc $state(body)] } @@ -4680,7 +4680,7 @@ proc http::GuessType {token} { return 0 } if {[package vsatisfies [package provide Tcl] 9.0-]} { - set state(body) [encoding convertfrom -profile tcl8 $enc $state(body)] + set state(body) [encoding convertfrom -profile replace $enc $state(body)] } else { set state(body) [encoding convertfrom $enc $state(body)] } @@ -4765,7 +4765,7 @@ proc http::quoteString {string} { # than [regsub]/[subst]). [Bug 1020491] if {[package vsatisfies [package provide Tcl] 9.0-]} { - set string [encoding convertto -profile tcl8 $http(-urlencoding) $string] + set string [encoding convertto -profile replace $http(-urlencoding) $string] } else { set string [encoding convertto $http(-urlencoding) $string] } @@ -4924,7 +4924,7 @@ proc http::ReceiveChunked {chan command} { } # http::SplitCommaSeparatedFieldValue -- -# Return the individual values of a comma-separated field value. +# Return the individual values of a comma-separated field value. # # Arguments: # fieldValue Comma-separated header field value. @@ -4941,7 +4941,7 @@ proc http::SplitCommaSeparatedFieldValue {fieldValue} { # http::GetFieldValue -- -# Return the value of a header field. +# Return the value of a header field. # # Arguments: # headers Headers key-value list diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 2428d53..209c2c0 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ if {![package vsatisfies [package provide Tcl] 8.6-]} {return} -package ifneeded http 2.10b2 [list tclPkgSetup $dir http 2.10b2 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +package ifneeded http 2.10.0 [list tclPkgSetup $dir http 2.10.0 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/manifest.txt b/library/manifest.txt index ab8bb15..a6eaec1 100644 --- a/library/manifest.txt +++ b/library/manifest.txt @@ -4,7 +4,7 @@ apply {{dir} { set isafe [interp issafe] foreach {safe package version file} { - 0 http 2.10b2 {http http.tcl} + 0 http 2.10.0 {http http.tcl} 1 msgcat 1.7.1 {msgcat msgcat.tcl} 1 opt 0.4.9 {opt optparse.tcl} 0 cookiejar 0.2.0 {cookiejar cookiejar.tcl} diff --git a/unix/Makefile.in b/unix/Makefile.in index 87189bc..e2d4e09 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1071,9 +1071,9 @@ install-libraries: libraries do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ done - @echo "Installing package http 2.10b2 as a Tcl Module" + @echo "Installing package http 2.10.0 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)/8.6/http-2.10b2.tm" + "$(MODULE_INSTALL_DIR)/8.6/http-2.10.0.tm" @echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/" @for i in $(TOP_DIR)/library/opt/*.tcl; do \ $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ diff --git a/win/Makefile.in b/win/Makefile.in index 5724c78..7d41db5 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -900,8 +900,8 @@ install-libraries: libraries install-tzdata install-msgs $(ROOT_DIR)/library/cookiejar/*.gz; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/cookiejar0.2"; \ done; - @echo "Installing package http 2.10b2 as a Tcl Module"; - @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10b2.tm"; + @echo "Installing package http 2.10.0 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/8.6/http-2.10.0.tm"; @echo "Installing package opt 0.4.7"; @for j in $(ROOT_DIR)/library/opt/*.tcl; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ -- cgit v0.12 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