diff options
| author | apnadkarni <apnmbx-wits@yahoo.com> | 2024-05-24 16:05:19 (GMT) |
|---|---|---|
| committer | apnadkarni <apnmbx-wits@yahoo.com> | 2024-05-24 16:05:19 (GMT) |
| commit | b7eeffcdef4802086b4f43db1619b2784d74aa79 (patch) | |
| tree | 0e5d90abdf8a9e69a0fc4383d8ceac9d115a02c4 | |
| parent | 14145609e7b52c939ce5bc328b87b8ab02c7a431 (diff) | |
| parent | b230de2a4d3e8748a542c21d0dfde9e357ac0b0a (diff) | |
| download | tcl-b7eeffcdef4802086b4f43db1619b2784d74aa79.zip tcl-b7eeffcdef4802086b4f43db1619b2784d74aa79.tar.gz tcl-b7eeffcdef4802086b4f43db1619b2784d74aa79.tar.bz2 | |
Merge trunk
101 files changed, 3657 insertions, 3455 deletions
diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 index 295ba77..0000000 --- a/.travis.yml +++ /dev/null @@ -1,380 +0,0 @@ -language: c -addons: - apt: - sources: - - ubuntu-toolchain-r-test - packages: - - binutils-mingw-w64-i686 - - binutils-mingw-w64-x86-64 - - gcc-mingw-w64 - - gcc-mingw-w64-base - - gcc-mingw-w64-i686 - - gcc-mingw-w64-x86-64 - - gcc-multilib -jobs: - include: -# Testing on Linux GCC - - name: "Linux/GCC/Shared" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - name: "Linux/GCC/Shared: NO_DEPRECATED" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" - - name: "Linux/GCC/Static" - os: linux - dist: focal - compiler: gcc - env: - - CFGOPT="--disable-shared" - - BUILD_DIR=unix - - name: "Linux/GCC/Debug" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols" - - name: "Linux/GCC/Mem-Debug" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols=mem" -# Newer/Older versions of GCC - - name: "Linux/GCC 10/Shared" - os: linux - dist: focal - compiler: gcc-10 - addons: - apt: - packages: - - g++-10 - env: - - BUILD_DIR=unix - - name: "Linux/GCC 5/Shared" - os: linux - dist: bionic - compiler: gcc-5 - addons: - apt: - packages: - - g++-5 - env: - - BUILD_DIR=unix -# Testing on Linux Clang - - name: "Linux/Clang/Shared" - os: linux - dist: focal - compiler: clang - env: - - BUILD_DIR=unix - - name: "Linux/Clang/Static" - os: linux - dist: focal - compiler: clang - env: - - CFGOPT="--disable-shared" - - BUILD_DIR=unix - - name: "Linux/Clang/Debug" - os: linux - dist: focal - compiler: clang - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols" - - name: "Linux/Clang/Mem-Debug" - os: linux - dist: focal - compiler: clang - env: - - BUILD_DIR=unix - - CFGOPT="--enable-symbols=mem" -# Testing on Mac, various styles - - name: "macOS/Clang/Xcode 12/Shared" - os: osx - osx_image: xcode12.2 - env: - - BUILD_DIR=macosx - install: [] - script: &mactest - - make all - # The styles=develop avoids some weird problems on OSX - - make test styles=develop - - name: "macOS/Clang/Xcode 12/Shared/Unix-like" - os: osx - osx_image: xcode12.2 - env: - - BUILD_DIR=unix - - CFGOPT="--enable-dtrace" - - name: "macOS/Clang/Xcode 12/Shared/libtommath" - os: osx - osx_image: xcode12.2 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - addons: - homebrew: - packages: - - libtommath -# Newer MacOS versions - - name: "macOS/Clang/Xcode 12/Universal Apps/Shared" - os: osx - osx_image: xcode12u - env: - - BUILD_DIR=macosx - install: [] - script: *mactest -# Older MacOS versions - - name: "macOS/Clang/Xcode 11/Shared" - os: osx - osx_image: xcode11.7 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - - name: "macOS/Clang/Xcode 10/Shared" - os: osx - osx_image: xcode10.3 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - - name: "macOS/Clang/Xcode 9/Shared" - os: osx - osx_image: xcode9.4 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest - - name: "macOS/Clang/Xcode 8/Shared" - os: osx - osx_image: xcode8.3 - env: - - BUILD_DIR=macosx - install: [] - script: *mactest -# Test with mingw-w64 cross-compile -# Doesn't run tests because wine is only an imperfect Windows emulation - - name: "Linux-cross-Windows/GCC/Shared/no test" - os: linux - dist: focal - compiler: x86_64-w64-mingw32-gcc - env: - - BUILD_DIR=win - - CFGOPT="--host=x86_64-w64-mingw32 --enable-64bit" - script: &crosstest - - make all tcltest - # Include a high visibility marker that tests are skipped outright - - > - echo "`tput setaf 3`SKIPPED TEST: CROSS COMPILING`tput sgr0`" -# Test with mingw-w64 (32 bit) cross-compile -# Doesn't run tests because wine is only an imperfect Windows emulation - - name: "Linux-cross-Windows-32/GCC/Shared/no test" - os: linux - dist: focal - compiler: i686-w64-mingw32-gcc - env: - - BUILD_DIR=win - - CFGOPT=--host=i686-w64-mingw32 - script: *crosstest -# Test on Windows with MSVC native - - name: "Windows/MSVC/Shared" - os: windows - compiler: cl - env: &vcenv - - BUILD_DIR=win - - VCDIR="/C/Program Files (x86)/Microsoft Visual Studio/2017/BuildTools/VC/Auxiliary/Build" - before_install: &vcpreinst - - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h - - PATH="$PATH:$VCDIR" - - cd ${BUILD_DIR} - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake '-f' makefile.vc test - - name: "Windows/MSVC/Shared: NO_DEPRECATED" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc test - - name: "Windows/MSVC/Static" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=static' '-f' makefile.vc test - - name: "Windows/MSVC/Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test - - name: "Windows/MSVC/Mem-Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x64 '&&' nmake 'STATS=memdbg' '-f' makefile.vc test -# Test on Windows with MSVC native (32-bit) - - name: "Windows/MSVC-x86/Shared" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake '-f' makefile.vc test - - name: "Windows/MSVC-x86/Shared: NO_DEPRECATED" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'CHECKS=nodep' '-f' makefile.vc test - - name: "Windows/MSVC-x86/Static" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=static' '-f' makefile.vc test - - name: "Windows/MSVC-x86/Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'OPTS=symbols' '-f' makefile.vc test - - name: "Windows/MSVC-x86/Mem-Debug" - os: windows - compiler: cl - env: *vcenv - before_install: *vcpreinst - install: [] - script: - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg' '-f' makefile.vc all tcltest - - cmd.exe //C vcvarsall.bat x86 '&&' nmake 'STATS=memdbg' '-f' makefile.vc test -# Test on Windows with GCC native - - name: "Windows/GCC/Shared" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit" - before_install: &makepreinst - - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h - - choco install -y make zip - - cd ${BUILD_DIR} - - name: "Windows/GCC/Shared: NO_DEPRECATED" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit CFLAGS=-DTCL_NO_DEPRECATED=1" - before_install: *makepreinst - - name: "Windows/GCC/Static" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --disable-shared" - before_install: *makepreinst - - name: "Windows/GCC/Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --enable-symbols" - before_install: *makepreinst - - name: "Windows/GCC/Mem-Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-64bit --enable-symbols=mem" - before_install: *makepreinst -# Test on Windows with GCC native (32-bit) - - name: "Windows/GCC-x86/Shared" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - before_install: *makepreinst - - name: "Windows/GCC-x86/Shared: NO_DEPRECATED" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="CFLAGS=-DTCL_NO_DEPRECATED=1" - before_install: *makepreinst - - name: "Windows/GCC-x86/Static" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--disable-shared" - before_install: *makepreinst - - name: "Windows/GCC-x86/Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-symbols" - before_install: *makepreinst - - name: "Windows/GCC-x86/Mem-Debug" - os: windows - compiler: gcc - env: - - BUILD_DIR=win - - CFGOPT="--enable-symbols=mem" - before_install: *makepreinst -# "make dist" only - - name: "Linux: make dist" - os: linux - dist: focal - compiler: gcc - env: - - BUILD_DIR=unix - script: - - make dist -before_install: - - touch generic/tclStubInit.c generic/tclOOStubInit.c generic/tclOOScript.h - - cd ${BUILD_DIR} -install: - - mkdir "$HOME/install dir" - - ./configure ${CFGOPT} "--prefix=$HOME/install dir" || (cat config.log && exit 1) -before_script: - - export ERROR_ON_FAILURES=1 -script: - - make all tcltest || echo "Something wrong, maybe a hickup, let's try again" - - make test - - make install @@ -1,6 +1,6 @@ # README: Tcl -This is the **Tcl 9.0b2** source distribution. +This is the **Tcl 9.0b3** source distribution. You can get any source release of Tcl from [our distribution site](https://sourceforge.net/projects/tcl/files/Tcl/). @@ -1,202 +1,86 @@ -# Tcl/Tk 9.0b2 Release Announcement -April ??, 2024 -The Tcl Core Team is pleased to announce the 9.0b2 releases of the Tcl -dynamic language and the Tk graphical interface package. These are the -second beta releases of Tcl 9.0 and Tk 9.0. More details can be found below. +The source code for Tcl is managed by fossil. Tcl developers coordinate all +changes to the Tcl source code at + +> [Tcl Source Code](https://core.tcl-lang.org/tcl/timeline) + +Release Tcl 9.0b3 arises from the check-in with tag core-9-0-b3. + +Highlighted differences between Tcl 9.0 and Tcl 8.6 are summarized below, +with focus on changes important to programmers using the Tcl library and +writing Tcl scripts. + +## 64-bit capacity: Data values larger than 2Gb + +## Internationalization of text + - Full Unicode range of codepoints + - New encodings: utf-16/utf-32/ucs-2(le|be), CESU-8, etc. + - `encoding` options -profile, -failindex manage encoding of I/O. + - `msgcat` supports custom locale search list + - `source` defaults to -encoding utf-8 + +## Zip filesystems and attached archives. + +## Unix notifiers available using epoll() or kqueue() + - relieves limits on file descriptors imposed by legacy select() + +## Notable incompatibilities + - Unqualified varnames resolved in current namespace, not global. + - No --disable-threads build option. Always thread-enabled. + - I/O malencoding default response: raise error (-profile strict) + - Windows platform needs Windows 7 or Windows Server 2008 R2 or later + - Ended interpretation of ~ as home directory in pathnames + - Removed the "identity" encoding + - $::tcl_precision no longer controls string generation of doubles + - Removed Tcl 7 legacies: [case], [puts] [read] variant syntaxes + - Removed subcommands [trace variable|vdelete|vinfo] + - No -eofchar option for channels anymore for writing. + - On Windows 10+ (Version 1903 or higher), system encoding is always utf-8. + +## Incompatibilities in C public interface + - Many arguments expanded type from int to Tcl_Size + - Ended support for Tcl_ChannelTypeVersion less than 5 + - Introduced versioning of the Tcl_ObjType struct + - Removed macros CONST*: Tcl 9 support means dropping Tcl 8.3 support + - Removed routines: +> Tcl_Backslash(), Tcl_*VA(), Tcl_*MathFunc*(), Tcl_MakeSafe(), +> Tcl_(Save|Restore|Discard|Free)Result(), Tcl_EvalTokens(), +> Tcl_(Get|Set)DefaultEncodingDir(), +> Tcl_UniCharN(case)cmp(), Tcl_UniCharCaseMatch() + +## New commands + - `array default`, `array for` + - `coroinject`, `coroprobe` + - `clock add weekdays` + - `const`, `info const*` + - `dict getdefault` + - `file tempdir`, `file home`, `file tildeexpand` + - `info commandtype` + - `ledit` + - `lpop` + - `lremove` + - `lseq` + - `package files` + - `string insert`, `string is dict` + - `tcl::process` + - `*::build-info` + +## New command options + - `regsub ... -command ...` + - `lsearch ... -stride ...` + - `clock scan ... -validate ...` + - `socket ... -nodelay ... -keepalive ...` + - `vwait` controlled by several new options + +## Numbers + - 0NNN format is no longer octal interpretation. Use 0oNNN. + - 0dNNNN format to compel decimal interpretation. + - NN_NNN_NNN, underscores in numbers for optional readability + - Functions: isinf() isnan() isnormal() issubnormal() isunordered() + - `fpclassify` + - Function int() no longer truncates to word size + +## tcl::oo facilities + - private variable and methods + - `method -export`, `method -unexport` -We would like to express our gratitude to all those who submit bug -reports and patches. This information is invaluable in enabling us -to identify and eliminate problems in the core. Such reports can be -submitted here. - - https://core.tcl-lang.org/tcl/ticket - https://core.tcl-lang.org/tk/ticket - -We ask that you log in (anonymous if you wish) to create tickets. -This deters abuse of the ticketing system. - -## Contents - 1. [Where to get the new releases](#wheretoget) - 2. [General Summary](#summary) - 3. [Some of the most noteworthy changes](#changes) - 4. [Tcl Improvement Proposals (TIPs)](#tips) - 5. [Additional support resources](#support) - 6. [For additional information](#info) - -## <a id="wheretoget">1.</a> Where to get the new releases - -Tcl/Tk 9.0b2 sources are freely available as open source from the Tcl -SourceForge project's file distribution area: - - https://sourceforge.net/projects/tcl/files/ - -This distribution is source code only. We keep links to some third -parties offering pre-built binaries for various systems here: - - https://www.tcl-lang.org/software/tcltk/bindist.html - -## <a id="summary">2.</a> General Summary - -These are new major versions of both Tcl and Tk. There are new features -to be enjoyed. There are incompatibilities to be considered. The list -of both is long and detailed and not fully included here. We believe many -scripts written for Tcl 8 will run unchanged in Tcl 9. We believe many more -can be modified in small and simple ways to produce a new script that runs -in both Tcl 8 and Tcl 9. We expect that extensions and applications using -the public C APIs of Tcl and Tk will involve more effort, but that it is -still within reasonable reach to produce source code supporting both Tcl 8 -and Tcl 9 while both releases remain in widespread use. - -These are beta releases. The developers believe the new feature set is -complete enough and the code quality is high enough that it is time for -a larger audience of Tcl/Tk users to give them a try and report back -to the developers what difficulties need resolution before stable -releases of Tcl/Tk 9.0.0. - -The experiences of Tcl/Tk 8 users adapting their code to the beta releases -of Tcl/Tk 9 will shape the final interfaces of Tcl/Tk 9.0.0, and will -determine the need for possible Tcl/Tk 8.7 releases that might supply -additional lifecycle and migration support. - -It is not recommended to deploy these beta releases directly to mission -critical use without significant testing and review. - -## <a id="changes">3.</a> Some of the most noteworthy changes - -Tcl 9: - - * 64-bit capacity: Data values larger than 2Gb - - * Internationalization of text - - Full Unicode range of codepoints - - New encodings: utf-16/utf-32/ucs-2(le|be), CESU-8, etc. - - [encoding] options -profile, -failindex manage encoding of I/O. - - [msgcat] supports custom locale search list - - [source] defaults to -encoding utf-8 - - * Zip filesystems and attached archives. - - * Unix notifiers available using epoll() or kqueue() - - relieves limits on file descriptors imposed by legacy select() - - * Notable incompatibilities - - Unqualified varnames resolved in current namespace, not global. - - No --disable-threads build option. Always thread-enabled. - - I/O malencoding default response: raise error (-profile strict) - - Windows platform needs Windows 7 or Windows Server 2008 R2 or later - - Ended interpretation of ~ as home directory in pathnames - - Removed the "identity" encoding - - $::tcl_precision no longer controls string generation of doubles - - Removed Tcl 7 legacies: [case], [puts] [read] variant syntaxes - - Removed subcommands [trace variable|vdelete|vinfo] - - No -eofchar option for channels anymore for writing. - - On Windows 10+ (Version 1903 or higher), system encoding is always utf-8. - - * Incompatibilities in C public interface - - Many arguments expanded type from int to Tcl_Size - - Ended support for Tcl_ChannelTypeVersion less than 5 - - Introduced versioning of the Tcl_ObjType struct - - Removed macros CONST*: Tcl 9 support means dropping Tcl 8.3 support - - Removed routines: - Tcl_Backslash(), Tcl_*VA(), Tcl_*MathFunc*(), Tcl_MakeSafe(), - Tcl_(Save|Restore|Discard|Free)Result(), Tcl_EvalTokens(), - Tcl_(Get|Set)DefaultEncodingDir(), - Tcl_UniCharN(case)cmp(), Tcl_UniCharCaseMatch() - - * New commands - - [array default], [array for] - - [coroinject], [coroprobe] - - [clock add weekdays] - - [const], [info const*] - - [dict getdefault] - - [file tempdir], [file home], [file tildeexpand] - - [info commandtype] - - [ledit] - - [lpop] - - [lremove] - - [lseq] - - [package files] - - [string insert], [string is dict] - - [tcl::process] - - [*::build-info] - - * New command options - - [regsub ... -command ...] - - [lsearch ... -stride ...] - - [clock scan ... -validate ...] - - [socket ... -nodelay ... -keepalive ...] - - [vwait] controlled by several new options - - * Numbers - - 0NNN format is no longer octal interpretation. Use 0oNNN. - - 0dNNNN format to compel decimal interpretation. - - NN_NNN_NNN, underscores in numbers for optional readability - - Functions: isinf() isnan() isnormal() issubnormal() isunordered() - - [fpclassify] - - Function int() no longer truncates to word size - - * tcl::oo facilities - - private variable and methods - - [method -export], [method -unexport] - -Tk 9: - - * Many improvements to use of platform features and conventions. - - Built-in widgets and themes are scaling-aware. - - Improved support of two-finger gestures, where available - - The [tk windowingsystem] "aqua" needs macOS 10.10 or later - - * New commands and options - - [tk sysnotify]: access to the OS notifications system - - [tk systray]: access to the OS tray facility - - [tk print]: access to the OS printing facility - - * Widget options - - New ttk::progressbar option: -text - - [$frame ... -backgroundimage $img -tile $bool] - - [$menu id], [$menu add|insert ... ?$id? ...] - - [$image get ... -withalpha ...] - - All indices now accept the forms "end", "end-int", "int+|-int" - - * Improved widget appearance - - ttk::notebook with nondefault tab positions - - * Images - - Partial SVG support - - Read/write access to photo image metadata - -## <a id="tips">4.</a> Tcl Improvement Proposals (TIPs) - -Each new user-visible feature in Tcl or Tk should find its origins in -a Tcl Improvement Proposal (TIP). TIPs are published, edited, considered -and voted in public, and should contain valuable information about how -a feature came to be the way it is. See the full collection here: - - https://tip.tcl-lang.org/ - -## <a id="support">5.</a> Additional support resources - -See the following links for an accumulation of migration advice: - -https://core.tcl-lang.org/tcl/wiki?name=Migrating+C+extensions+to+Tcl+9 -https://core.tcl-lang.org/tcl/wiki?name=Migrating+scripts+to+Tcl+9 - -There has been much progress already porting many known applications, -extensions, and packages in the Tcl world to compatibility with Tcl/Tk 9: - -https://wiki.tcl-lang.org/page/Apps+confirmed+to+work+with+Tcl+9 -https://wiki.tcl-lang.org/page/Porting+extensions+to+Tcl+9 - -## <a id="info">6.</a> For additional information: - -Please visit the Tcl Developer Xchange web site: - - https://www.tcl-lang.org/ - -This site contains a variety of information about Tcl/Tk in general, the -core Tcl and Tk distributions, Tcl development tools, and much more. - --- -Tcl Core Team and Maintainers -Don Porter, Tcl Core Release Manager
\ No newline at end of file @@ -1,7 +1,6 @@ '\" '\" Copyright (c) 1993 The Regents of the University of California. '\" Copyright (c) 1994-1996 Sun Microsystems, Inc. -'\" Copyright (c) 2023 Nathan Coulter '\" '\" See the file "license.terms" for information on usage and redistribution '\" of this file, and for a DISCLAIMER OF ALL WARRANTIES. @@ -17,191 +16,257 @@ Summary of Tcl language syntax. .SH DESCRIPTION .PP The following rules define the syntax and semantics of the Tcl language: -. -.IP "[1] \fBScript.\fR" -A script is composed of zero or more commands delimited by semi-colons or -newlines. -.IP "[2] \fBCommand.\fR" -A command is composed of zero or more words delimited by whitespace. The -replacement for a substitution is included verbatim in the word. For example, a -space in the replacement is included in the word rather than becoming a -delimiter, and \fI\\\\\fR becomes a single backslash in the word. Each word is -processed from left to right and each substitution is performed as soon as it -is complete. -For example, the command -.RS -.PP -.CS -set y [set x 0][incr x][incr x] -.CE -.PP -is composed of three words, and sets the value of \fIy\fR to \fI012\fR. -.PP -If hash -.PQ # -is the first character of what would otherwise be the first word of a command, -all characters up to the next newline are ignored. -.RE -. -.IP "[3] \fBBraced word.\fR" -If a word is enclosed in braces -.PQ { -and -.PQ } "" -, the braces are removed and the enclosed characters become the word. No -substitutions are performed. Nested pairs of braces may occur within the word. -A brace preceded by an odd number of backslashes is not considered part of a -pair, and neither brace nor the backslashes are removed from the word. -. -.IP "[4] \fBQuoted word.\fR" -If a word is enclosed in double quotes +.IP "[1] \fBCommands.\fR" +A Tcl script is a string containing one or more commands. +Semi-colons and newlines are command separators unless quoted as +described below. +Close brackets are command terminators during command substitution +(see below) unless quoted. +.IP "[2] \fBEvaluation.\fR" +A command is evaluated in two steps. +First, the Tcl interpreter breaks the command into \fIwords\fR +and performs substitutions as described below. +These substitutions are performed in the same way for all +commands. +Secondly, the first word is used to locate a routine to +carry out the command, and the remaining words of the command are +passed to that routine. +The routine is free to interpret each of its words +in any way it likes, such as an integer, variable name, list, +or Tcl script. +Different commands interpret their words differently. +.IP "[3] \fBWords.\fR" +Words of a command are separated by white space (except for +newlines, which are command separators). +.IP "[4] \fBDouble quotes.\fR" +If the first character of a word is double-quote .PQ \N'34' -, the double quotes are removed and the enclosed characters become the word. -Substitutions are performed. -. -.IP "[5] \fBList.\fR" -A list has the form of a single command. Newline is whitespace, and semicolon -has no special interpretation. There is no script evaluation so there is no -argument expansion, variable substitution, or command substitution: Dollar-sign -and open bracket have no special interpretation, and what would be argument -expansion in a script is invalid in a list. -. -.IP "[6] \fBArgument expansion.\fR" -If +then the word is terminated by the next double-quote character. +If semi-colons, close brackets, or white space characters +(including newlines) appear between the quotes then they are treated +as ordinary characters and included in the word. +Command substitution, variable substitution, and backslash substitution +are performed on the characters between the quotes as described below. +The double-quotes are not retained as part of the word. +.IP "[5] \fBArgument expansion.\fR" +If a word starts with the string .QW {*} -prefixes a word, it is removed. After any remaining enclosing braces or quotes -are processed and applicable substitutions performed, the word, which must -be a list, is removed from the command, and in its place each word in the -list becomes an additional word in the command. For example, -.CS -cmd a {*}{b [c]} d {*}{$e f {g h}} -.CE +followed by a non-whitespace character, then the leading +.QW {*} +is removed and the rest of the word is parsed and substituted as any other +word. After substitution, the word is parsed as a list (without command or +variable substitutions; backslash substitutions are performed as is normal for +a list and individual internal words may be surrounded by either braces or +double-quote characters), and its words are added to the command being +substituted. For instance, +.QW "cmd a {*}{b [c]} d {*}{$e f {g h}}" is equivalent to -.CS -cmd a b {[c]} d {$e} f {g h} . -.CE -. -.IP "[7] \fBEvaluation.\fR" -To evaluate a script, an interpreter evaluates each successive command. The -first word identifies a procedure, and the remaining words are passed to that -procedure for further evaluation. The procedure interprets each argument in -its own way, e.g. as an integer, variable name, list, mathematical expression, -script, or in some other arbitrary way. The result of the last command is the -result of the script. -. -.IP "[8] \fBCommand substitution.\fR" -Each pair of brackets +.QW "cmd a b {[c]} d {$e} f {g h}" . +.IP "[6] \fBBraces.\fR" +If the first character of a word is an open brace +.PQ { +and rule [5] does not apply, then +the word is terminated by the matching close brace +.PQ } "" . +Braces nest within the word: for each additional open +brace there must be an additional close brace (however, +if an open brace or close brace within the word is +quoted with a backslash then it is not counted in locating the +matching close brace). +No substitutions are performed on the characters between the +braces except for backslash-newline substitutions described +below, nor do semi-colons, newlines, close brackets, +or white space receive any special interpretation. +The word will consist of exactly the characters between the +outer braces, not including the braces themselves. +.IP "[7] \fBCommand substitution.\fR" +If a word contains an open bracket .PQ [ -and -.PQ ] "" -encloses a script and is replaced by the result of that script. -.IP "[9] \fBVariable substitution.\fR" -Each of the following forms begins with dollar sign +then Tcl performs \fIcommand substitution\fR. +To do this it invokes the Tcl interpreter recursively to process +the characters following the open bracket as a Tcl script. +The script may contain any number of commands and must be terminated +by a close bracket +.PQ ] "" . +The result of the script (i.e. the result of its last command) is +substituted into the word in place of the brackets and all of the +characters between them. +There may be any number of command substitutions in a single word. +Command substitution is not performed on words enclosed in braces. +.IP "[8] \fBVariable substitution.\fR" +If a word contains a dollar-sign .PQ $ -and is replaced by the value of the identified variable. \fIname\fR names the -variable and is composed of ASCII letters (\fBA\fR\(en\fBZ\fR and -\fBa\fR\(en\fBz\fR), digits (\fB0\fR\(en\fB9\fR), underscores, or namespace -delimiters (two or more colons). \fIindex\fR is the name of an individual -variable within an array variable, and may be empty. +followed by one of the forms +described below, then Tcl performs \fIvariable +substitution\fR: the dollar-sign and the following characters are +replaced in the word by the value of a variable. +Variable substitution may take any of the following forms: .RS .TP 15 \fB$\fIname\fR . -\fIname\fR may not be empty. +\fIName\fR is the name of a scalar variable; the name is a sequence +of one or more characters that are a letter, digit, underscore, +or namespace separators (two or more colons). +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). .TP 15 \fB$\fIname\fB(\fIindex\fB)\fR . -\fIname\fR may be empty. Substitutions are performed on \fIindex\fR. +\fIName\fR gives the name of an array variable and \fIindex\fR gives +the name of an element within that array. +\fIName\fR must contain only letters, digits, underscores, and +namespace separators, and may be an empty string. +Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR, +\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR). +Command substitutions, variable substitutions, and backslash +substitutions are performed on the characters of \fIindex\fR. .TP 15 \fB${\fIname\fB}\fR . -\fIname\fR may be empty. -.TP 15 -\fB${\fIname(index)\fB}\fR -. -\fIname\fR may be empty. No substitutions are performed. +\fIName\fR is the name of a scalar variable or array element. It may contain +any characters whatsoever except for close braces. It indicates an array +element if \fIname\fR is in the form +.QW \fIarrayName\fB(\fIindex\fB)\fR +where \fIarrayName\fR does not contain any open parenthesis characters, +.QW \fB(\fR , +or close brace characters, +.QW \fB}\fR , +and \fIindex\fR can be any sequence of characters except for close brace +characters. No further +substitutions are performed during the parsing of \fIname\fR. +.PP +There may be any number of variable substitutions in a single word. +Variable substitution is not performed on words enclosed in braces. +.PP +Note that variables may contain character sequences other than those listed +above, but in that case other mechanisms must be used to access them (e.g., +via the \fBset\fR command's single-argument form). .RE -Variables that are not accessible through one of the forms above may be -accessed through other mechanisms, e.g. the \fBset\fR command. -.IP "[10] \fBBackslash substitution.\fR" -Each backslash +.IP "[9] \fBBackslash substitution.\fR" +If a backslash .PQ \e -that is not part of one of the forms listed below is removed, and the next -character is included in the word verbatim, which allows the inclusion of -characters that would normally be interpreted, namely whitespace, braces, -brackets, double quote, dollar sign, and backslash. The following sequences -are replaced as described: +appears within a word then \fIbackslash substitution\fR occurs. +In all cases but those described below the backslash is dropped and +the following character is treated as an ordinary +character and included in the word. +This allows characters such as double quotes, close brackets, +and dollar signs to be included in words without triggering +special processing. +The following table lists the backslash sequences that are +handled specially, along with the value that replaces each sequence. .RS .RS .RS .TP 7 \e\fBa\fR -. -Audible alert (bell) (U+7). +Audible alert (bell) (Unicode U+000007). .TP 7 \e\fBb\fR -. -Backspace (U+8). +Backspace (Unicode U+000008). .TP 7 \e\fBf\fR -. -Form feed (U+C). +Form feed (Unicode U+00000C). .TP 7 \e\fBn\fR -. -Newline (U+A). +Newline (Unicode U+00000A). .TP 7 \e\fBr\fR -. -Carriage-return (U+D). +Carriage-return (Unicode U+00000D). .TP 7 \e\fBt\fR -. -Tab (U+9). +Tab (Unicode U+000009). .TP 7 \e\fBv\fR -. -Vertical tab (U+B). +Vertical tab (Unicode U+00000B). .TP 7 \e\fB<newline>\fIwhiteSpace\fR . -Newline preceded by an odd number of backslashes, along with the consecutive -spaces and tabs that immediately follow it, is replaced by a single space. -Because this happens before the command is split into words, it occurs even -within braced words, and if the resulting space may subsequently be treated as -a word delimiter. +A single space character replaces the backslash, newline, and all spaces +and tabs after the newline. This backslash sequence is unique in that it +is replaced in a separate pre-pass before the command is actually parsed. +This means that it will be replaced even when it occurs between braces, +and the resulting space will be treated as a word separator if it is not +in braces or quotes. .TP 7 \e\e -. Backslash .PQ \e "" . .TP 7 \e\fIooo\fR . -Up to three octal digits form an eight-bit value for a Unicode character in the -range \fI0\fR\(en\fI377\fR, i.e. U+0\(enU+FF. Only the digits that result in a -number in this range are consumed. +The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal +value for the Unicode character that will be inserted, in the range +\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF). +The parser will stop just before this range overflows, or when +the maximum of three digits is reached. The upper bits of the Unicode +character will be 0. .TP 7 \e\fBx\fIhh\fR . -Up to two hexadecimal digits form an eight-bit value for a Unicode character in -the range \fI0\fR\(en\fIFF\fR. +The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit +hexadecimal value for the Unicode character that will be inserted. The upper +bits of the Unicode character will be 0 (i.e., the character will be in the +range U+000000\(enU+0000FF). .TP 7 \e\fBu\fIhhhh\fR . -Up to four hexadecimal digits form a 16-bit value for a Unicode character in -the range \fI0\fR\(en\fIFFFF\fR. +The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a +sixteen-bit hexadecimal value for the Unicode character that will be +inserted. The upper bits of the Unicode character will be 0 (i.e., the +character will be in the range U+000000\(enU+00FFFF). .TP 7 \e\fBU\fIhhhhhhhh\fR . -Up to eight hexadecimal digits form a 21-bit value for a Unicode character in -the range \fI0\fR\(en\fI10FFFF\fR. Only the digits that result in a number in -this range are consumed. +The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a +twenty-one-bit hexadecimal value for the Unicode character that will be +inserted, in the range U+000000\(enU+10FFFF. The parser will stop just +before this range overflows, or when the maximum of eight digits +is reached. The upper bits of the Unicode character will be 0. .RE .RE .PP +Backslash substitution is not performed on words enclosed in braces, +except for backslash-newline as described above. .RE -. +.IP "[10] \fBComments.\fR" +If a hash character +.PQ # +appears at a point where Tcl is +expecting the first character of the first word of a command, +then the hash character and the characters that follow it, up +through the next newline, are treated as a comment and ignored. +The comment character only has significance when it appears +at the beginning of a command. +.IP "[11] \fBOrder of substitution.\fR" +Each character is processed exactly once by the Tcl interpreter +as part of creating the words of a command. +For example, if variable substitution occurs then no further +substitutions are performed on the value of the variable; the +value is inserted into the word verbatim. +If command substitution occurs then the nested command is +processed entirely by the recursive call to the Tcl interpreter; +no substitutions are performed before making the recursive +call and no additional substitutions are performed on the result +of the nested script. +.RS +.PP +Substitutions take place from left to right, and each substitution is +evaluated completely before attempting to evaluate the next. Thus, a +sequence like +.PP +.CS +set y [set x 0][incr x][incr x] +.CE +.PP +will always set the variable \fIy\fR to the value, \fI012\fR. +.RE +.IP "[12] \fBSubstitution and word boundaries.\fR" +Substitutions do not affect the word boundaries of a command, +except for argument expansion as specified in rule [5]. +For example, during variable substitution the entire value of +the variable becomes part of a single word, even if the variable's +value contains spaces. .SH KEYWORDS backslash, command, comment, script, substitution, variable '\" Local Variables: diff --git a/doc/define.n b/doc/define.n index 91d927c..775cdc4 100644 --- a/doc/define.n +++ b/doc/define.n @@ -9,7 +9,7 @@ .BS '\" Note: do not modify the .SH NAME line immediately below! .SH NAME -oo::define, oo::objdefine \- define and configure classes and objects +oo::define, oo::objdefine, oo::Slot \- define and configure classes and objects .SH SYNOPSIS .nf package require tcl::oo @@ -18,6 +18,13 @@ package require tcl::oo \fBoo::define\fI class subcommand arg\fR ?\fIarg ...\fR? \fBoo::objdefine\fI object defScript\fR \fBoo::objdefine\fI object subcommand arg\fR ?\fIarg ...\fR? + +\fBoo::Slot\fR \fIarg...\fR +.fi +.SH "CLASS HIERARCHY" +.nf +\fBoo::object\fR + \(-> \fBoo::Slot\fR .fi .BE .SH DESCRIPTION @@ -514,8 +521,10 @@ Some of the configurable definitions of a class or object are \fIslotted definitions\fR. This means that the configuration is implemented by a slot object, that is an instance of the class \fBoo::Slot\fR, which manages a list of values (class names, variable names, etc.) that comprises the contents of -the slot. The class defines six operations (as methods) that may be done on -the slot: +the slot. +.PP +The \fBoo::Slot\fR class defines six operations (as methods) that may be done +on the slot: .\" METHOD: -append .TP \fIslot\fR \fB\-append\fR ?\fImember ...\fR? @@ -554,6 +563,10 @@ This replaces the slot definition with the given \fImember\fR elements. A consequence of this is that any use of a slot's default operation where the first member argument begins with a hyphen will be an error. One of the above operations should be used explicitly in those circumstances. +.PP +You only need to make an instance of \fBoo::Slot\fR if you are definining your +own slot that behaves like a standard slot. +.PP .SS "SLOT IMPLEMENTATION" .\" METHOD: --default-operation Internally, slot objects also define a method \fB\-\-default\-operation\fR @@ -597,6 +610,16 @@ Implementations \fIshould not\fR enforce uniqueness and ordering constraints in this method; that is the responsibility of the \fBSet\fR method. .RE .VE TIP516 +.\" METHOD: Resolve +.TP +\fIslot\fR \fBResolve \fIelement\fR +.VS +This converts an element of the slotted collection into its resolved form; for +a simple value, it could just return the value, but for a slot that contains +references to commands or classes it should convert those into their +fully-qualified forms (so they can be compared with \fBstring equals\fR): that +could be done by forwarding to \fBnamespace which\fR or similar. +.VE .\" METHOD: Set .TP \fIslot\fR \fBSet \fIelementList\fR @@ -619,8 +642,14 @@ The implementation of these methods is slot-dependent (and responsible for accessing the correct part of the class or object definition). Slots also have an unknown method handler to tie all these pieces together, and they hide their \fBdestroy\fR method so that it is not invoked inadvertently. It is -\fIrecommended\fR that any user changes to the slot mechanism be restricted to -defining new operations whose names start with a hyphen. +\fIrecommended\fR that any user changes to the slot mechanism itself be +restricted to defining new operations whose names start with a hyphen. +.PP +Note that slot instances are not expected to contain the storage for the slot +they manage; that will be in or attached to the class or object that they +manage. Those instances should provide their own implementations of the +\fBGet\fR and \fBSet\fR methods (and optionally \fBResolve\fR; that defaults +to a do-nothing pass-through). .PP .VS TIP516 Most slot operations will initially \fBResolve\fR their argument list, combine @@ -107,9 +107,6 @@ The input substring must be a decimal integer. The integer value is truncated as required by the size modifier value, and the corresponding unsigned value for that truncated range is computed and stored in the variable as a decimal string. -The conversion makes no sense without reference to a truncation range, -so the size modifier \fBll\fR is not permitted in combination -with conversion character \fBu\fR. .IP \fBi\fR The input substring must be an integer. The base (i.e. decimal, octal, or hexadecimal) is determined by the C convention (leading diff --git a/doc/unknown.n b/doc/unknown.n index ee8a5be..8ea1e8e 100644 --- a/doc/unknown.n +++ b/doc/unknown.n @@ -47,7 +47,7 @@ The default implementation of \fBunknown\fR behaves as follows. It first calls the \fBauto_load\fR library procedure to load the command. If this succeeds, then it executes the original command with its original arguments. -If the auto-load fails then \fBunknown\fR calls \fBauto_execok\fR +If the auto-load fails and Tcl is run interactively then \fBunknown\fR calls \fBauto_execok\fR to see if there is an executable file by the name \fIcmd\fR. If so, it invokes the Tcl \fBexec\fR command with \fIcmd\fR and all the \fIargs\fR as arguments. diff --git a/generic/tcl.h b/generic/tcl.h index e40e8a9..41e68a8 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -48,15 +48,15 @@ extern "C" { */ #if !defined(TCL_MAJOR_VERSION) -# define TCL_MAJOR_VERSION 9 +# define TCL_MAJOR_VERSION 9 #endif #if TCL_MAJOR_VERSION == 9 -# define TCL_MINOR_VERSION 0 -# define TCL_RELEASE_LEVEL TCL_BETA_RELEASE -# define TCL_RELEASE_SERIAL 2 +# define TCL_MINOR_VERSION 0 +# define TCL_RELEASE_LEVEL TCL_BETA_RELEASE +# define TCL_RELEASE_SERIAL 3 -# define TCL_VERSION "9.0" -# define TCL_PATCH_LEVEL "9.0b2" +# define TCL_VERSION "9.0" +# define TCL_PATCH_LEVEL "9.0b3" #endif /* TCL_MAJOR_VERSION */ #if defined(RC_INVOKED) @@ -90,7 +90,8 @@ extern "C" { * Special macro to define mutexes. */ -#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name; +#define TCL_DECLARE_MUTEX(name) \ + static Tcl_Mutex name; /* * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and @@ -464,9 +465,9 @@ typedef void (Tcl_ThreadCreateProc) (void *clientData); typedef struct Tcl_RegExpIndices { #if TCL_MAJOR_VERSION > 8 - Tcl_Size start; /* Character offset of first character in + Tcl_Size start; /* Character offset of first character in * match. */ - Tcl_Size end; /* Character offset of first character after + Tcl_Size end; /* Character offset of first character after * the match. */ #else long start; @@ -475,11 +476,11 @@ typedef struct Tcl_RegExpIndices { } Tcl_RegExpIndices; typedef struct Tcl_RegExpInfo { - Tcl_Size nsubs; /* Number of subexpressions in the compiled + Tcl_Size nsubs; /* Number of subexpressions in the compiled * expression. */ Tcl_RegExpIndices *matches; /* Array of nsubs match offset pairs. */ #if TCL_MAJOR_VERSION > 8 - Tcl_Size extendStart; /* The offset at which a subsequent match + Tcl_Size extendStart; /* The offset at which a subsequent match * might begin. */ #else long extendStart; @@ -615,28 +616,25 @@ typedef void (Tcl_ServiceModeHookProc) (int mode); typedef void *(Tcl_InitNotifierProc) (void); typedef void (Tcl_FinalizeNotifierProc) (void *clientData); typedef void (Tcl_MainLoopProc) (void); - + /* Abstract List functions */ -typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); -typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size index, struct Tcl_Obj** elemObj); -typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size fromIdx, Tcl_Size toIdx, - struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - struct Tcl_Obj **newObjPtr); -typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); -typedef struct Tcl_Obj* (Tcl_ObjTypeSetElement) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, - Tcl_Size indexCount, - struct Tcl_Obj *const indexArray[], - struct Tcl_Obj *valueObj); -typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, struct Tcl_Obj *listObj, - Tcl_Size first, Tcl_Size numToDelete, - Tcl_Size numToInsert, - struct Tcl_Obj *const insertObjs[]); -typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, struct Tcl_Obj *valueObj, - struct Tcl_Obj *listObj, int *boolResult); +typedef Tcl_Size (Tcl_ObjTypeLengthProc) (struct Tcl_Obj *listPtr); +typedef int (Tcl_ObjTypeIndexProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size index, struct Tcl_Obj** elemObj); +typedef int (Tcl_ObjTypeSliceProc) (Tcl_Interp *interp, struct Tcl_Obj *listPtr, + Tcl_Size fromIdx, Tcl_Size toIdx, struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeReverseProc) (Tcl_Interp *interp, + struct Tcl_Obj *listPtr, struct Tcl_Obj **newObjPtr); +typedef int (Tcl_ObjTypeGetElements) (Tcl_Interp *interp, + struct Tcl_Obj *listPtr, Tcl_Size *objcptr, struct Tcl_Obj ***objvptr); +typedef struct Tcl_Obj *(Tcl_ObjTypeSetElement) (Tcl_Interp *interp, + struct Tcl_Obj *listPtr, Tcl_Size indexCount, + struct Tcl_Obj *const indexArray[], struct Tcl_Obj *valueObj); +typedef int (Tcl_ObjTypeReplaceProc) (Tcl_Interp *interp, + struct Tcl_Obj *listObj, Tcl_Size first, Tcl_Size numToDelete, + Tcl_Size numToInsert, struct Tcl_Obj *const insertObjs[]); +typedef int (Tcl_ObjTypeInOperatorProc) (Tcl_Interp *interp, + struct Tcl_Obj *valueObj, struct Tcl_Obj *listObj, int *boolResult); #ifndef TCL_NO_DEPRECATED # define Tcl_PackageInitProc Tcl_LibraryInitProc @@ -670,33 +668,36 @@ typedef struct Tcl_ObjType { size_t version; /* List emulation functions - ObjType Version 1 */ - Tcl_ObjTypeLengthProc *lengthProc; /* Return the [llength] of the - ** AbstractList */ - Tcl_ObjTypeIndexProc *indexProc; /* Return a value (Tcl_Obj) for - ** [lindex $al $index] */ - Tcl_ObjTypeSliceProc *sliceProc; /* Return an AbstractList for - ** [lrange $al $start $end] */ - Tcl_ObjTypeReverseProc *reverseProc; /* Return an AbstractList for - ** [lreverse $al] */ - Tcl_ObjTypeGetElements *getElementsProc; /* Return an objv[] of all elements in - ** the list */ - Tcl_ObjTypeSetElement *setElementProc; /* Replace the element at the indicie - ** with the given valueObj. */ - Tcl_ObjTypeReplaceProc *replaceProc; /* Replace subset with subset */ - Tcl_ObjTypeInOperatorProc *inOperProc; /* "in" and "ni" expr list - ** operation Determine if the given - ** string value matches an element in - ** the list */ + Tcl_ObjTypeLengthProc *lengthProc; + /* Return the [llength] of the AbstractList */ + Tcl_ObjTypeIndexProc *indexProc; + /* Return a value (Tcl_Obj) at a given index */ + Tcl_ObjTypeSliceProc *sliceProc; + /* Return an AbstractList for + * [lrange $al $start $end] */ + Tcl_ObjTypeReverseProc *reverseProc; + /* Return an AbstractList for [lreverse $al] */ + Tcl_ObjTypeGetElements *getElementsProc; + /* Return an objv[] of all elements in the list */ + Tcl_ObjTypeSetElement *setElementProc; + /* Replace the element at the indicies with the + * given valueObj. */ + Tcl_ObjTypeReplaceProc *replaceProc; + /* Replace sublist with another sublist */ + Tcl_ObjTypeInOperatorProc *inOperProc; + /* "in" and "ni" expr list operation. + * Determine if the given string value matches + * an element in the list. */ #endif } Tcl_ObjType; #if TCL_MAJOR_VERSION > 8 # define TCL_OBJTYPE_V0 0, \ - 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */ + 0,0,0,0,0,0,0,0 /* Pre-Tcl 9 */ # define TCL_OBJTYPE_V1(a) offsetof(Tcl_ObjType, indexProc), \ - a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */ + a,0,0,0,0,0,0,0 /* Tcl 9 Version 1 */ # define TCL_OBJTYPE_V2(a,b,c,d,e,f,g,h) sizeof(Tcl_ObjType), \ - a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */ + a,b,c,d,e,f,g,h /* Tcl 9 - AbstractLists */ #else # define TCL_OBJTYPE_V0 /* just empty */ #endif @@ -749,9 +750,9 @@ typedef struct Tcl_Obj { * corresponds to the type of the object's * internal rep. NULL indicates the object has * no internal rep (has no type). */ - Tcl_ObjInternalRep internalRep; /* The internal representation: */ + Tcl_ObjInternalRep internalRep; + /* The internal representation: */ } Tcl_Obj; - /* *---------------------------------------------------------------------------- @@ -767,7 +768,7 @@ typedef struct Tcl_Namespace { * is an synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* Arbitrary value associated with this + void *clientData; /* Arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Function invoked when deleting the @@ -841,11 +842,11 @@ typedef struct { Tcl_ObjCmdProc *objProc; /* Command's object-based function. */ void *objClientData; /* ClientData for object proc. */ Tcl_CmdProc *proc; /* Command's string-based function. */ - void *clientData; /* ClientData for string proc. */ + void *clientData; /* ClientData for string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Function to call when command is * deleted. */ - void *deleteData; /* Value to pass to deleteProc (usually the + void *deleteData; /* Value to pass to deleteProc (usually the * same as clientData). */ Tcl_Namespace *namespacePtr;/* Points to the namespace that contains this * command. Note that Tcl_SetCmdInfo will not @@ -964,7 +965,7 @@ typedef struct Tcl_DString { * TCL_CANCEL_UNWIND: Magical Tcl_CancelEval mode that causes the * stack for the script in progress to be * completely unwound. - * TCL_EVAL_NOERR: Do no exception reporting at all, just return + * TCL_EVAL_NOERR: Do no exception reporting at all, just return * as the caller will report. */ @@ -1077,7 +1078,7 @@ struct Tcl_HashEntry { * or NULL for end of chain. */ Tcl_HashTable *tablePtr; /* Pointer to table containing entry. */ size_t hash; /* Hash value. */ - void *clientData; /* Application stores something here with + void *clientData; /* Application stores something here with * Tcl_SetHashValue. */ union { /* Key has one of these forms: */ char *oneWordValue; /* One-word value for key. */ @@ -1173,11 +1174,11 @@ struct Tcl_HashTable { Tcl_HashEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables (to * avoid mallocs and frees). */ - Tcl_Size numBuckets; /* Total number of buckets allocated at + Tcl_Size numBuckets; /* Total number of buckets allocated at * **bucketPtr. */ - Tcl_Size numEntries; /* Total number of entries present in + Tcl_Size numEntries; /* Total number of entries present in * table. */ - Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be + Tcl_Size rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ #if TCL_MAJOR_VERSION > 8 size_t mask; /* Mask value used in hashing function. */ @@ -1186,7 +1187,7 @@ struct Tcl_HashTable { * Designed to use high-order bits of * randomized keys. */ #if TCL_MAJOR_VERSION < 9 - int mask; /* Mask value used in hashing function. */ + int mask; /* Mask value used in hashing function. */ #endif int keyType; /* Type of keys used in this table. It's * either TCL_CUSTOM_KEYS, TCL_STRING_KEYS, @@ -1776,8 +1777,8 @@ typedef struct Tcl_Token { int type; /* Type of token, such as TCL_TOKEN_WORD; see * below for valid types. */ const char *start; /* First character in token. */ - Tcl_Size size; /* Number of bytes in token. */ - Tcl_Size numComponents; /* If this token is composed of other tokens, + Tcl_Size size; /* Number of bytes in token. */ + Tcl_Size numComponents; /* If this token is composed of other tokens, * this field tells how many of them there are * (including components of components, etc.). * The component tokens immediately follow @@ -1891,13 +1892,13 @@ typedef struct Tcl_Token { typedef struct Tcl_Parse { const char *commentStart; /* Pointer to # that begins the first of one * or more comments preceding the command. */ - Tcl_Size commentSize; /* Number of bytes in comments (up through + Tcl_Size commentSize; /* Number of bytes in comments (up through * newline character that terminates the last * comment). If there were no comments, this * field is 0. */ const char *commandStart; /* First character in first word of * command. */ - Tcl_Size commandSize; /* Number of bytes in command, including first + Tcl_Size commandSize; /* Number of bytes in command, including first * character of first word, up through the * terminating newline, close bracket, or * semicolon. */ @@ -1967,7 +1968,7 @@ typedef struct Tcl_EncodingType { Tcl_FreeProc *freeProc; /* If non-NULL, function to call when this * encoding is deleted. */ - void *clientData; /* Arbitrary value associated with encoding + void *clientData; /* Arbitrary value associated with encoding * type. Passed to conversion functions. */ Tcl_Size nullSize; /* Number of zero bytes that signify * end-of-string in this encoding. This number @@ -2173,7 +2174,7 @@ typedef struct { * depends on type.*/ const char *helpStr; /* Documentation message describing this * option. */ - void *clientData; /* Word to pass to function callbacks. */ + void *clientData; /* Word to pass to function callbacks. */ } Tcl_ArgvInfo; /* @@ -2293,9 +2294,9 @@ typedef int (Tcl_NRPostProc) (void *data[], Tcl_Interp *interp, */ #if TCL_MAJOR_VERSION > 8 -# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) +# define TCL_STUB_MAGIC ((int) 0xFCA3BACB + (int) sizeof(void *)) #else -# define TCL_STUB_MAGIC ((int) 0xFCA3BACF) +# define TCL_STUB_MAGIC ((int) 0xFCA3BACF) #endif /* @@ -2312,7 +2313,7 @@ const char * TclTomMathInitializeStubs(Tcl_Interp *interp, const char * TclInitStubTable(const char *version); void * TclStubCall(void *arg); #if defined(_WIN32) - TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); + TCL_NORETURN void Tcl_ConsolePanic(const char *format, ...); #else # define Tcl_ConsolePanic ((Tcl_PanicProc *)NULL) #endif @@ -2360,7 +2361,8 @@ void * TclStubCall(void *arg); * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171] */ -#define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \ +#define Tcl_Main(argc, argv, proc) \ + Tcl_MainEx(argc, argv, proc, \ ((Tcl_SetPanicProc(Tcl_ConsolePanic), Tcl_CreateInterp()))) EXTERN TCL_NORETURN void Tcl_MainEx(Tcl_Size argc, char **argv, Tcl_AppInitProc *appInitProc, Tcl_Interp *interp); @@ -2379,9 +2381,9 @@ EXTERN void Tcl_StaticLibrary(Tcl_Interp *interp, #ifndef TCL_NO_DEPRECATED # define Tcl_StaticPackage Tcl_StaticLibrary #endif -EXTERN Tcl_ExitProc *Tcl_SetExitProc(Tcl_ExitProc *proc); +EXTERN Tcl_ExitProc * Tcl_SetExitProc(Tcl_ExitProc *proc); #ifdef _WIN32 -EXTERN const char *TclZipfs_AppHook(int *argc, wchar_t ***argv); +EXTERN const char * TclZipfs_AppHook(int *argc, wchar_t ***argv); #else EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); #endif @@ -2501,7 +2503,11 @@ EXTERN const char *TclZipfs_AppHook(int *argc, char ***argv); # define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr, __FILE__, __LINE__) -static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) +static inline void +TclBounceRefCount( + Tcl_Obj* objPtr, + const char* fn, + int line) { if (objPtr) { if ((objPtr)->refCount == 0) { @@ -2519,11 +2525,11 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) */ # undef Tcl_DecrRefCount # define Tcl_DecrRefCount(objPtr) \ - do { \ - Tcl_Obj *_objPtr = (objPtr); \ - if (_objPtr->refCount-- <= 1) { \ - TclFreeObj(_objPtr); \ - } \ + do { \ + Tcl_Obj *_objPtr = (objPtr); \ + if (_objPtr->refCount-- <= 1) { \ + TclFreeObj(_objPtr); \ + } \ } while(0) # undef Tcl_IsShared # define Tcl_IsShared(objPtr) \ @@ -2534,10 +2540,12 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr, const char* fn, int line) * This will release the obj if there is no referece count, * otherwise let it be. */ -# define Tcl_BounceRefCount(objPtr) \ +# define Tcl_BounceRefCount(objPtr) \ TclBounceRefCount(objPtr); -static inline void TclBounceRefCount(Tcl_Obj* objPtr) +static inline void +TclBounceRefCount( + Tcl_Obj* objPtr) { if (objPtr) { if ((objPtr)->refCount == 0) { @@ -2589,10 +2597,10 @@ static inline void TclBounceRefCount(Tcl_Obj* objPtr) #define Tcl_GetHashValue(h) ((h)->clientData) #define Tcl_SetHashValue(h, value) ((h)->clientData = (void *)(value)) #define Tcl_GetHashKey(tablePtr, h) \ - ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ - (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ - ? (h)->key.oneWordValue \ - : (h)->key.string)) + ((void *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \ + (tablePtr)->keyType == TCL_CUSTOM_PTR_KEYS) \ + ? (h)->key.oneWordValue \ + : (h)->key.string)) /* * Macros to use for clients to use to invoke find and create functions for diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c index 3c4fac3..b52d1b3 100644 --- a/generic/tclAlloc.c +++ b/generic/tclAlloc.c @@ -47,17 +47,18 @@ typedef size_t caddr_t; */ union overhead { - union overhead *next; /* when free */ - unsigned char padding[TCL_ALLOCALIGN]; /* align struct to TCL_ALLOCALIGN bytes */ + union overhead *next; /* when free */ + unsigned char padding[TCL_ALLOCALIGN]; + /* align struct to TCL_ALLOCALIGN bytes */ struct { - unsigned char magic0; /* magic number */ - unsigned char index; /* bucket # */ - unsigned char unused; /* unused */ - unsigned char magic1; /* other magic number */ + unsigned char magic0; /* magic number */ + unsigned char index; /* bucket # */ + unsigned char unused; /* unused */ + unsigned char magic1; /* other magic number */ #ifndef NDEBUG - unsigned short rmagic; /* range magic number */ + unsigned short rmagic; /* range magic number */ size_t size; /* actual block size */ - unsigned short unused2; /* padding to 8-byte align */ + unsigned short unused2; /* padding to 8-byte align */ #endif } ovu; #define overMagic0 ovu.magic0 @@ -67,7 +68,6 @@ union overhead { #define realBlockSize ovu.size }; - #define MAGIC 0xEF /* magic # on accounting info */ #define RMAGIC 0x5555 /* magic # on range info */ @@ -92,7 +92,8 @@ union overhead { * precedes the data area returned to the user. */ -#define MINBLOCK ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) +#define MINBLOCK \ + ((sizeof(union overhead) + (TCL_ALLOCALIGN-1)) & ~(TCL_ALLOCALIGN-1)) #define NBUCKETS (13 - (MINBLOCK >> 4)) #define MAXMALLOC ((size_t)1 << (NBUCKETS+2)) static union overhead *nextf[NBUCKETS]; @@ -251,7 +252,7 @@ TclFinalizeAllocSubsystem(void) void * TclpAlloc( - size_t numBytes) /* Number of bytes to allocate. */ + size_t numBytes) /* Number of bytes to allocate. */ { union overhead *overPtr; size_t bucket; @@ -385,10 +386,10 @@ TclpAlloc( static void MoreCore( - size_t bucket) /* What bucket to allocate to. */ + size_t bucket) /* What bucket to allocate to. */ { union overhead *overPtr; - size_t size; /* size of desired block */ + size_t size; /* size of desired block */ size_t amount; /* amount to allocate */ size_t numBlocks; /* how many blocks we get */ struct block *blockPtr; @@ -511,7 +512,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloc'ed block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { int i; union overhead *overPtr; @@ -743,7 +744,7 @@ TclpFree( void * TclpRealloc( void *oldPtr, /* Pointer to alloced block. */ - size_t numBytes) /* New size of memory. */ + size_t numBytes) /* New size of memory. */ { return realloc(oldPtr, numBytes); } diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 3faa201..209df16 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -63,7 +63,6 @@ /* actually there is no fallback to builtin fpclassify */ #endif /* !TCL_FPCLASSIFY_MODE */ - /* * Bug 7371b6270b: to check C call stack depth, prefer an approach which is * compatible with AddressSanitizer (ASan) use-after-return detection. @@ -85,17 +84,17 @@ void * TclGetCStackPtr(void) { #if defined( __GNUC__ ) || __has_builtin(__builtin_frame_address) - return __builtin_frame_address(0); + return __builtin_frame_address(0); #elif defined(_MSC_VER) && defined(HAVE_INTRIN_H) - return _AddressOfReturnAddress(); + return _AddressOfReturnAddress(); #else - ptrdiff_t unused = 0; - /* - * LLVM recommends using volatile: - * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 - */ - ptrdiff_t *volatile stackLevel = &unused; - return (void *)stackLevel; + ptrdiff_t unused = 0; + /* + * LLVM recommends using volatile: + * https://github.com/llvm/llvm-project/blob/llvmorg-10.0.0-rc1/clang/lib/Basic/Stack.cpp#L31 + */ + ptrdiff_t *volatile stackLevel = &unused; + return (void *)stackLevel; #endif } @@ -168,7 +167,7 @@ TCL_DECLARE_MUTEX(commandTypeLock); * Static functions in this file: */ -static Tcl_ObjCmdProc BadEnsembleSubcommand; +static Tcl_ObjCmdProc BadEnsembleSubcommand; static char * CallCommandTraces(Interp *iPtr, Command *cmdPtr, const char *oldName, const char *newName, int flags); @@ -193,12 +192,12 @@ static Tcl_ObjCmdProc ExprDoubleFunc; static Tcl_ObjCmdProc ExprFloorFunc; static Tcl_ObjCmdProc ExprIntFunc; static Tcl_ObjCmdProc ExprIsqrtFunc; -static Tcl_ObjCmdProc ExprIsFiniteFunc; -static Tcl_ObjCmdProc ExprIsInfinityFunc; -static Tcl_ObjCmdProc ExprIsNaNFunc; -static Tcl_ObjCmdProc ExprIsNormalFunc; -static Tcl_ObjCmdProc ExprIsSubnormalFunc; -static Tcl_ObjCmdProc ExprIsUnorderedFunc; +static Tcl_ObjCmdProc ExprIsFiniteFunc; +static Tcl_ObjCmdProc ExprIsInfinityFunc; +static Tcl_ObjCmdProc ExprIsNaNFunc; +static Tcl_ObjCmdProc ExprIsNormalFunc; +static Tcl_ObjCmdProc ExprIsSubnormalFunc; +static Tcl_ObjCmdProc ExprIsUnorderedFunc; static Tcl_ObjCmdProc ExprMaxFunc; static Tcl_ObjCmdProc ExprMinFunc; static Tcl_ObjCmdProc ExprRandFunc; @@ -207,7 +206,7 @@ static Tcl_ObjCmdProc ExprSqrtFunc; static Tcl_ObjCmdProc ExprSrandFunc; static Tcl_ObjCmdProc ExprUnaryFunc; static Tcl_ObjCmdProc ExprWideFunc; -static Tcl_ObjCmdProc FloatClassifyObjCmd; +static Tcl_ObjCmdProc FloatClassifyObjCmd; static void MathFuncWrongNumArgs(Tcl_Interp *interp, int expected, int actual, Tcl_Obj *const *objv); static Tcl_NRPostProc NRCoroutineCallerCallback; @@ -219,13 +218,13 @@ static void ProcessUnexpectedResult(Tcl_Interp *interp, static int RewindCoroutine(CoroutineData *corPtr, int result); static void TEOV_SwitchVarFrame(Tcl_Interp *interp); static void TEOV_PushExceptionHandlers(Tcl_Interp *interp, - int objc, Tcl_Obj *const objv[], int flags); + Tcl_Size objc, Tcl_Obj *const objv[], int flags); static inline Command * TEOV_LookupCmdFromObj(Tcl_Interp *interp, Tcl_Obj *namePtr, Namespace *lookupNsPtr); -static int TEOV_NotFound(Tcl_Interp *interp, int objc, +static int TEOV_NotFound(Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr); static int TEOV_RunEnterTraces(Tcl_Interp *interp, - Command **cmdPtrPtr, Tcl_Obj *commandPtr, int objc, + Command **cmdPtrPtr, Tcl_Obj *commandPtr, Tcl_Size objc, Tcl_Obj *const objv[]); static Tcl_NRPostProc RewindCoroutineCallback; static Tcl_NRPostProc TEOEx_ByteCodeCallback; @@ -253,11 +252,11 @@ MODULE_SCOPE const TclStubs tclStubs; * after particular kinds of [yield]. */ -#define CORO_ACTIVATE_YIELD NULL -#define CORO_ACTIVATE_YIELDM INT2PTR(1) +#define CORO_ACTIVATE_YIELD NULL +#define CORO_ACTIVATE_YIELDM INT2PTR(1) -#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) -#define COROUTINE_ARGUMENTS_ARBITRARY (-2) +#define COROUTINE_ARGUMENTS_SINGLE_OPTIONAL (-1) +#define COROUTINE_ARGUMENTS_ARBITRARY (-2) /* * The following structure define the commands in the Tcl core. @@ -271,9 +270,9 @@ typedef struct { int flags; /* Various flag bits, as defined below. */ } CmdInfo; -#define CMD_IS_SAFE 1 /* Whether this command is part of the set of - * commands present by default in a safe - * interpreter. */ +#define CMD_IS_SAFE 1 /* Whether this command is part of the set of + * commands present by default in a safe + * interpreter. */ /* CMD_COMPILES_EXPANDED - Whether the compiler for this command can handle * expansion for itself rather than needing the generic layer to take care of * it for it. Defined in tclInt.h. */ @@ -287,13 +286,13 @@ typedef struct { */ typedef struct { - const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for - * the end of the list of commands to hide. */ - const char *commandName; /* The name of the command within the - * ensemble. If this is NULL, we want to also - * make the overall command be hidden, an ugly - * hack because it is expected by security - * policies in the wild. */ + const char *ensembleNsName; /* The ensemble's name within ::tcl. NULL for + * the end of the list of commands to hide. */ + const char *commandName; /* The name of the command within the + * ensemble. If this is NULL, we want to also + * make the overall command be hidden, an ugly + * hack because it is expected by security + * policies in the wild. */ } UnsafeEnsembleInfo; /* @@ -322,8 +321,8 @@ static const CmdInfo builtInCmds[] = { {"concat", Tcl_ConcatObjCmd, TclCompileConcatCmd, NULL, CMD_IS_SAFE}, {"const", Tcl_ConstObjCmd, TclCompileConstCmd, NULL, CMD_IS_SAFE}, {"continue", Tcl_ContinueObjCmd, TclCompileContinueCmd, NULL, CMD_IS_SAFE}, - {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, - {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, + {"coroinject", NULL, NULL, TclNRCoroInjectObjCmd, CMD_IS_SAFE}, + {"coroprobe", NULL, NULL, TclNRCoroProbeObjCmd, CMD_IS_SAFE}, {"coroutine", NULL, NULL, TclNRCoroutineObjCmd, CMD_IS_SAFE}, {"error", Tcl_ErrorObjCmd, TclCompileErrorCmd, NULL, CMD_IS_SAFE}, {"eval", Tcl_EvalObjCmd, NULL, TclNREvalObjCmd, CMD_IS_SAFE}, @@ -331,7 +330,7 @@ static const CmdInfo builtInCmds[] = { {"for", Tcl_ForObjCmd, TclCompileForCmd, TclNRForObjCmd, CMD_IS_SAFE}, {"foreach", Tcl_ForeachObjCmd, TclCompileForeachCmd, TclNRForeachCmd, CMD_IS_SAFE}, {"format", Tcl_FormatObjCmd, TclCompileFormatCmd, NULL, CMD_IS_SAFE}, - {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"fpclassify", FloatClassifyObjCmd, NULL, NULL, CMD_IS_SAFE}, {"global", Tcl_GlobalObjCmd, TclCompileGlobalCmd, NULL, CMD_IS_SAFE}, {"if", Tcl_IfObjCmd, TclCompileIfCmd, TclNRIfObjCmd, CMD_IS_SAFE}, {"incr", Tcl_IncrObjCmd, TclCompileIncrCmd, NULL, CMD_IS_SAFE}, @@ -346,12 +345,12 @@ static const CmdInfo builtInCmds[] = { {"lmap", Tcl_LmapObjCmd, TclCompileLmapCmd, TclNRLmapCmd, CMD_IS_SAFE}, {"lpop", Tcl_LpopObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrange", Tcl_LrangeObjCmd, TclCompileLrangeCmd, NULL, CMD_IS_SAFE}, - {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lremove", Tcl_LremoveObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lrepeat", Tcl_LrepeatObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lreplace", Tcl_LreplaceObjCmd, TclCompileLreplaceCmd, NULL, CMD_IS_SAFE}, {"lreverse", Tcl_LreverseObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lsearch", Tcl_LsearchObjCmd, NULL, NULL, CMD_IS_SAFE}, - {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, + {"lseq", Tcl_LseqObjCmd, NULL, NULL, CMD_IS_SAFE}, {"lset", Tcl_LsetObjCmd, TclCompileLsetCmd, NULL, CMD_IS_SAFE}, {"lsort", Tcl_LsortObjCmd, NULL, NULL, CMD_IS_SAFE}, {"package", Tcl_PackageObjCmd, NULL, TclNRPackageObjCmd, CMD_IS_SAFE}, @@ -479,48 +478,52 @@ static const UnsafeEnsembleInfo unsafeEnsembleCommands[] = { * Math functions. All are safe. */ +typedef double (BuiltinUnaryFunc)(double x); +typedef double (BuiltinBinaryFunc)(double x, double y); +#define BINARY_TYPECAST(fn) \ + (BuiltinUnaryFunc *)(void *)(BuiltinBinaryFunc *) fn typedef struct { const char *name; /* Name of the function. The full name is * "::tcl::mathfunc::<name>". */ Tcl_ObjCmdProc *objCmdProc; /* Function that evaluates the function */ - double (*fn)(double x); /* Real function pointer */ + BuiltinUnaryFunc *fn; /* Real function pointer */ } BuiltinFuncDef; static const BuiltinFuncDef BuiltinFuncTable[] = { { "abs", ExprAbsFunc, NULL }, { "acos", ExprUnaryFunc, acos }, { "asin", ExprUnaryFunc, asin }, { "atan", ExprUnaryFunc, atan }, - { "atan2", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) atan2}, + { "atan2", ExprBinaryFunc, BINARY_TYPECAST(atan2) }, { "bool", ExprBoolFunc, NULL }, { "ceil", ExprCeilFunc, NULL }, - { "cos", ExprUnaryFunc, cos }, + { "cos", ExprUnaryFunc, cos }, { "cosh", ExprUnaryFunc, cosh }, { "double", ExprDoubleFunc, NULL }, { "entier", ExprIntFunc, NULL }, - { "exp", ExprUnaryFunc, exp }, + { "exp", ExprUnaryFunc, exp }, { "floor", ExprFloorFunc, NULL }, - { "fmod", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) fmod}, - { "hypot", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) hypot}, + { "fmod", ExprBinaryFunc, BINARY_TYPECAST(fmod) }, + { "hypot", ExprBinaryFunc, BINARY_TYPECAST(hypot) }, { "int", ExprIntFunc, NULL }, - { "isfinite", ExprIsFiniteFunc, NULL }, - { "isinf", ExprIsInfinityFunc, NULL }, - { "isnan", ExprIsNaNFunc, NULL }, - { "isnormal", ExprIsNormalFunc, NULL }, + { "isfinite", ExprIsFiniteFunc, NULL }, + { "isinf", ExprIsInfinityFunc, NULL }, + { "isnan", ExprIsNaNFunc, NULL }, + { "isnormal", ExprIsNormalFunc, NULL }, { "isqrt", ExprIsqrtFunc, NULL }, - { "issubnormal", ExprIsSubnormalFunc, NULL, }, - { "isunordered", ExprIsUnorderedFunc, NULL, }, - { "log", ExprUnaryFunc, log }, + { "issubnormal", ExprIsSubnormalFunc, NULL, }, + { "isunordered", ExprIsUnorderedFunc, NULL, }, + { "log", ExprUnaryFunc, log }, { "log10", ExprUnaryFunc, log10 }, { "max", ExprMaxFunc, NULL }, { "min", ExprMinFunc, NULL }, - { "pow", ExprBinaryFunc, (double (*)(double))(void *)(double (*)(double, double)) pow}, + { "pow", ExprBinaryFunc, BINARY_TYPECAST(pow) }, { "rand", ExprRandFunc, NULL }, { "round", ExprRoundFunc, NULL }, - { "sin", ExprUnaryFunc, sin }, + { "sin", ExprUnaryFunc, sin }, { "sinh", ExprUnaryFunc, sinh }, { "sqrt", ExprSqrtFunc, NULL }, { "srand", ExprSrandFunc, NULL }, - { "tan", ExprUnaryFunc, tan }, + { "tan", ExprUnaryFunc, tan }, { "tanh", ExprUnaryFunc, tanh }, { "wide", ExprWideFunc, NULL }, { NULL, NULL, NULL } @@ -628,8 +631,8 @@ TclFinalizeEvaluation(void) Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_DeleteHashTable(&commandTypeTable); - commandTypeInit = 0; + Tcl_DeleteHashTable(&commandTypeTable); + commandTypeInit = 0; } Tcl_MutexUnlock(&commandTypeLock); } @@ -657,82 +660,108 @@ buildInfoObjCmd2( Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { + const char *buildData = (const char *) clientData; + char buf[80]; + const char *arg, *p, *q; + Tcl_Size len; + int idx; + static const char *identifiers[] = { + "commit", "compiler", "patchlevel", "version", NULL + }; + enum Identifiers { + ID_COMMIT, ID_COMPILER, ID_PATCHLEVEL, ID_VERSION, ID_OTHER + }; + if (objc > 2) { Tcl_WrongNumArgs(interp, 1, objv, "?option?"); return TCL_ERROR; + } else if (objc < 2) { + Tcl_SetObjResult(interp, Tcl_NewStringObj(buildData, TCL_INDEX_NONE)); + return TCL_OK; } - if (objc == 2) { - Tcl_Size len; - const char *arg = TclGetStringFromObj(objv[1], &len); - if (len == 7 && !strcmp(arg, "version")) { - char buf[80]; - const char *p = strchr((char *)clientData, '.'); - if (p) { - const char *q = strchr(p+1, '.'); - const char *r = strchr(p+1, '+'); - p = (q < r) ? q : r; - } - if (p) { - memcpy(buf, (char *)clientData, p - (char *)clientData); - buf[p - (char *)clientData] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); - } - return TCL_OK; - } else if (len == 10 && !strcmp(arg, "patchlevel")) { - char buf[80]; - const char *p = strchr((char *)clientData, '+'); - if (p) { - memcpy(buf, (char *)clientData, p - (char *)clientData); - buf[p - (char *)clientData] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); + + /* + * Query for a specific piece of build info + */ + + if (Tcl_GetIndexFromObj(NULL, objv[1], identifiers, NULL, TCL_EXACT, + &idx) != TCL_OK) { + idx = ID_OTHER; + } + + switch (idx) { + case ID_PATCHLEVEL: + if ((p = strchr(buildData, '+')) != NULL) { + memcpy(buf, buildData, p - buildData); + buf[p - buildData] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); + } + return TCL_OK; + case ID_VERSION: + if ((p = strchr(buildData, '.')) != NULL) { + const char *r = strchr(p++, '+'); + q = strchr(p, '.'); + p = (q < r) ? q : r; + } + if (p != NULL) { + memcpy(buf, buildData, p - buildData); + buf[p - buildData] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); + } + return TCL_OK; + case ID_COMMIT: + if ((p = strchr(buildData, '+')) != NULL) { + if ((q = strchr(p++, '.')) != NULL) { + memcpy(buf, p, q - p); + buf[q - p] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); + } else { + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, TCL_INDEX_NONE)); } - return TCL_OK; - } else if (len == 6 && !strcmp(arg, "commit")) { - const char *q, *p = strchr((char *)clientData, '+'); - if (p) { - if ((q = strchr(p, '.'))) { - char buf[80]; - memcpy(buf, p+1, q - p - 1); - buf[q - p - 1] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); + } + return TCL_OK; + case ID_COMPILER: + for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) { + /* + * Does the word begin with one of the standard prefixes? + */ + if (!strncmp(p, "clang-", 6) + || !strncmp(p, "gcc-", 4) + || !strncmp(p, "icc-", 4) + || !strncmp(p, "msvc-", 5)) { + if ((q = strchr(p, '.')) != NULL) { + memcpy(buf, p, q - p); + buf[q - p] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); } else { - Tcl_AppendResult(interp, p+1, (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(p, TCL_INDEX_NONE)); } + return TCL_OK; } - return TCL_OK; - } else if (len == 8 && !strcmp(arg, "compiler")) { - const char *p = strchr((char *)clientData, '.'); - while (p) { - if (!strncmp(p+1, "clang-", 6) || !strncmp(p+1, "gcc-", 4) - || !strncmp(p+1, "icc-", 4) || !strncmp(p+1, "msvc-", 5)) { - const char *q = strchr(p+1, '.'); - if (q) { - char buf[16]; - memcpy(buf, p+1, q - p - 1); - buf[q - p - 1] = '\0'; - Tcl_AppendResult(interp, buf, (char *)NULL); - } else { - Tcl_AppendResult(interp, p+1, (char *)NULL); + } + break; + default: /* Boolean test for other identifiers' presence */ + arg = TclGetStringFromObj(objv[1], &len); + for (p = strchr(buildData, '.'); p++; p = strchr(p, '.')) { + if (!strncmp(p, arg, len) + && ((p[len] == '.') || (p[len] == '-') || (p[len] == '\0'))) { + if (p[len] == '-') { + p += len; + q = strchr(++p, '.'); + if (!q) { + q = p + strlen(p); } - return TCL_OK; + memcpy(buf, p, q - p); + buf[q - p] = '\0'; + Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, TCL_INDEX_NONE)); + } else { + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(1)); } - p = strchr(p+1, '.'); - } - Tcl_AppendResult(interp, "0", (char *)NULL); - return TCL_OK; - } - const char *p = strchr((char *)clientData, '.'); - while (p) { - if (!strncmp(p+1, arg, len) && ((p[len+1] == '.') || (p[len+1] == '\0'))) { - Tcl_AppendResult(interp, "1", (char *)NULL); return TCL_OK; } - p = strchr(p+1, '.'); } - Tcl_AppendResult(interp, "0", (char *)NULL); - return TCL_OK; } - Tcl_AppendResult(interp, (char *)clientData, (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewBooleanObj(0)); return TCL_OK; } @@ -819,16 +848,16 @@ Tcl_CreateInterp(void) #undef TclObjInterpProc if (commandTypeInit == 0) { - TclRegisterCommandTypeName(TclObjInterpProc, "proc"); - TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); - TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); - TclRegisterCommandTypeName(TclChildObjCmd, "interp"); - TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); - TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); - TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); - TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); - TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); + TclRegisterCommandTypeName(TclObjInterpProc, "proc"); + TclRegisterCommandTypeName(TclEnsembleImplementationCmd, "ensemble"); + TclRegisterCommandTypeName(TclAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclLocalAliasObjCmd, "alias"); + TclRegisterCommandTypeName(TclChildObjCmd, "interp"); + TclRegisterCommandTypeName(TclInvokeImportedCmd, "import"); + TclRegisterCommandTypeName(TclOOPublicObjectCmd, "object"); + TclRegisterCommandTypeName(TclOOPrivateObjectCmd, "privateObject"); + TclRegisterCommandTypeName(TclOOMyClassObjCmd, "privateClass"); + TclRegisterCommandTypeName(TclNRInterpCoroutine, "coroutine"); } /* @@ -941,7 +970,7 @@ Tcl_CreateInterp(void) iPtr->flags |= INTERP_DEBUG_FRAME; #else if (getenv("TCL_INTERP_DEBUG_FRAME") != NULL) { - iPtr->flags |= INTERP_DEBUG_FRAME; + iPtr->flags |= INTERP_DEBUG_FRAME; } #endif @@ -1098,9 +1127,9 @@ Tcl_CreateInterp(void) cmdPtr->deleteProc = NULL; cmdPtr->deleteData = NULL; cmdPtr->flags = 0; - if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { - cmdPtr->flags |= CMD_COMPILES_EXPANDED; - } + if (cmdInfoPtr->flags & CMD_COMPILES_EXPANDED) { + cmdPtr->flags |= CMD_COMPILES_EXPANDED; + } cmdPtr->importRefPtr = NULL; cmdPtr->tracePtr = NULL; cmdPtr->nreProc = cmdInfoPtr->nreProc; @@ -1160,15 +1189,15 @@ Tcl_CreateInterp(void) /* Adding the bytecode assembler command */ cmdPtr = (Command *) Tcl_NRCreateCommand(interp, - "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, - TclNRAssembleObjCmd, NULL, NULL); + "::tcl::unsupported::assemble", Tcl_AssembleObjCmd, + TclNRAssembleObjCmd, NULL, NULL); cmdPtr->compileProc = &TclCompileAssembleCmd; /* Coroutine monkeybusiness */ Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL, NRInjectObjCmd, NULL, NULL); Tcl_CreateObjCommand(interp, "::tcl::unsupported::corotype", - CoroTypeObjCmd, NULL, NULL); + CoroTypeObjCmd, NULL, NULL); /* Export unsupported commands */ nsPtr = Tcl_FindNamespace(interp, "::tcl::unsupported", NULL, 0); @@ -1176,7 +1205,6 @@ Tcl_CreateInterp(void) Tcl_Export(interp, nsPtr, "*", 1); } - #ifdef USE_DTRACE /* * Register the tcl::dtrace command. @@ -1197,7 +1225,7 @@ Tcl_CreateInterp(void) memcpy(mathFuncName, "::tcl::mathfunc::", MATH_FUNC_PREFIX_LEN); for (builtinFuncPtr = BuiltinFuncTable; builtinFuncPtr->name != NULL; builtinFuncPtr++) { - strcpy(mathFuncName+MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); + strcpy(mathFuncName + MATH_FUNC_PREFIX_LEN, builtinFuncPtr->name); Tcl_CreateObjCommand(interp, mathFuncName, builtinFuncPtr->objCmdProc, (void *)builtinFuncPtr->fn, NULL); Tcl_Export(interp, nsPtr, builtinFuncPtr->name, 0); @@ -1331,10 +1359,10 @@ DeleteOpCmdClientData( * * TclRegisterCommandTypeName, TclGetCommandTypeName -- * - * Command type registration and lookup mechanism. Everything is keyed by - * the Tcl_ObjCmdProc for the command, and that is used as the *key* into - * the hash table that maps to constant strings that are names. (It is - * recommended that those names be ASCII.) + * Command type registration and lookup mechanism. Everything is keyed by + * the Tcl_ObjCmdProc for the command, and that is used as the *key* into + * the hash table that maps to constant strings that are names. (It is + * recommended that those names be ASCII.) * * --------------------------------------------------------------------- */ @@ -1348,21 +1376,21 @@ TclRegisterCommandTypeName( Tcl_MutexLock(&commandTypeLock); if (commandTypeInit == 0) { - Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); - commandTypeInit = 1; + Tcl_InitHashTable(&commandTypeTable, TCL_ONE_WORD_KEYS); + commandTypeInit = 1; } if (nameStr != NULL) { - int isNew; + int isNew; - hPtr = Tcl_CreateHashEntry(&commandTypeTable, - implementationProc, &isNew); - Tcl_SetHashValue(hPtr, (void *) nameStr); + hPtr = Tcl_CreateHashEntry(&commandTypeTable, + implementationProc, &isNew); + Tcl_SetHashValue(hPtr, (void *) nameStr); } else { - hPtr = Tcl_FindHashEntry(&commandTypeTable, - implementationProc); - if (hPtr != NULL) { - Tcl_DeleteHashEntry(hPtr); - } + hPtr = Tcl_FindHashEntry(&commandTypeTable, + implementationProc); + if (hPtr != NULL) { + Tcl_DeleteHashEntry(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); } @@ -1376,15 +1404,15 @@ TclGetCommandTypeName( const char *name = "native"; if (procPtr == NULL) { - procPtr = cmdPtr->nreProc; + procPtr = cmdPtr->nreProc; } Tcl_MutexLock(&commandTypeLock); if (commandTypeInit) { - Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(&commandTypeTable, procPtr); - if (hPtr && Tcl_GetHashValue(hPtr)) { - name = (const char *) Tcl_GetHashValue(hPtr); - } + if (hPtr && Tcl_GetHashValue(hPtr)) { + name = (const char *) Tcl_GetHashValue(hPtr); + } } Tcl_MutexUnlock(&commandTypeLock); @@ -1424,41 +1452,43 @@ TclHideUnsafeCommands( } for (unsafePtr = unsafeEnsembleCommands; - unsafePtr->ensembleNsName; unsafePtr++) { - if (unsafePtr->commandName) { - /* - * Hide an ensemble subcommand. - */ - - Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", - unsafePtr->ensembleNsName, unsafePtr->commandName); - - if (TclRenameCommand(interp, TclGetString(cmdName), - "___tmp") != TCL_OK - || Tcl_HideCommand(interp, "___tmp", - TclGetString(hideName)) != TCL_OK) { - Tcl_Panic("problem making '%s %s' safe: %s", - unsafePtr->ensembleNsName, unsafePtr->commandName, - Tcl_GetStringResult(interp)); - } - Tcl_CreateObjCommand(interp, TclGetString(cmdName), - BadEnsembleSubcommand, (void *)unsafePtr, NULL); - TclDecrRefCount(cmdName); - TclDecrRefCount(hideName); - } else { - /* - * Hide an ensemble main command (for compatibility). - */ - - if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, - unsafePtr->ensembleNsName) != TCL_OK) { - Tcl_Panic("problem making '%s' safe: %s", - unsafePtr->ensembleNsName, - Tcl_GetStringResult(interp)); - } - } + unsafePtr->ensembleNsName; unsafePtr++) { + if (unsafePtr->commandName) { + /* + * Hide an ensemble subcommand. + */ + + Tcl_Obj *cmdName = Tcl_ObjPrintf("::tcl::%s::%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + Tcl_Obj *hideName = Tcl_ObjPrintf("tcl:%s:%s", + unsafePtr->ensembleNsName, unsafePtr->commandName); + +#define INTERIM_HACK_NAME "___tmp" + + if (TclRenameCommand(interp, TclGetString(cmdName), + INTERIM_HACK_NAME) != TCL_OK + || Tcl_HideCommand(interp, INTERIM_HACK_NAME, + TclGetString(hideName)) != TCL_OK) { + Tcl_Panic("problem making '%s %s' safe: %s", + unsafePtr->ensembleNsName, unsafePtr->commandName, + Tcl_GetStringResult(interp)); + } + Tcl_CreateObjCommand(interp, TclGetString(cmdName), + BadEnsembleSubcommand, (void *)unsafePtr, NULL); + TclDecrRefCount(cmdName); + TclDecrRefCount(hideName); + } else { + /* + * Hide an ensemble main command (for compatibility). + */ + + if (Tcl_HideCommand(interp, unsafePtr->ensembleNsName, + unsafePtr->ensembleNsName) != TCL_OK) { + Tcl_Panic("problem making '%s' safe: %s", + unsafePtr->ensembleNsName, + Tcl_GetStringResult(interp)); + } + } } return TCL_OK; @@ -1492,8 +1522,8 @@ BadEnsembleSubcommand( const UnsafeEnsembleInfo *infoPtr = (const UnsafeEnsembleInfo *)clientData; Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "not allowed to invoke subcommand %s of %s", - infoPtr->commandName, infoPtr->ensembleNsName)); + "not allowed to invoke subcommand %s of %s", + infoPtr->commandName, infoPtr->ensembleNsName)); Tcl_SetErrorCode(interp, "TCL", "SAFE", "SUBCOMMAND", (char *)NULL); return TCL_ERROR; } @@ -1524,12 +1554,12 @@ Tcl_CallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; static Tcl_ThreadDataKey assocDataCounterKey; - int *assocDataCounterPtr = - (int *)Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); + int *assocDataCounterPtr = (int *) + Tcl_GetThreadData(&assocDataCounterKey, sizeof(int)); int isNew; char buffer[32 + TCL_INTEGER_SPACE]; AssocData *dPtr = (AssocData *)Tcl_Alloc(sizeof(AssocData)); @@ -1572,7 +1602,7 @@ Tcl_DontCallWhenDeleted( Tcl_Interp *interp, /* Interpreter to watch. */ Tcl_InterpDeleteProc *proc, /* Function to call when interpreter is about * to be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; Tcl_HashTable *hTablePtr; @@ -1620,7 +1650,7 @@ Tcl_SetAssocData( const char *name, /* Name for association. */ Tcl_InterpDeleteProc *proc, /* Proc to call when interpreter is about to * be deleted. */ - void *clientData) /* One-word value to pass to proc. */ + void *clientData) /* One-word value to pass to proc. */ { Interp *iPtr = (Interp *) interp; AssocData *dPtr; @@ -1937,7 +1967,6 @@ DeleteInterpProc( Tcl_Free(hTablePtr); } - if (iPtr->assocData != NULL) { AssocData *dPtr; @@ -2189,8 +2218,8 @@ Tcl_HideCommand( if (strstr(hiddenCmdToken, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "cannot use namespace qualifiers in hidden command" - " token (rename)", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); + " token (rename)", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "HIDDENTOKEN", (char *)NULL); return TCL_ERROR; } @@ -2213,9 +2242,9 @@ Tcl_HideCommand( if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only hide global namespace commands (use rename then hide)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); + "can only hide global namespace commands (use rename then hide)", + TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2239,9 +2268,9 @@ Tcl_HideCommand( hPtr = Tcl_CreateHashEntry(hiddenCmdTablePtr, hiddenCmdToken, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "hidden command named \"%s\" already exists", - hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); + "hidden command named \"%s\" already exists", + hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "HIDE", "ALREADY_HIDDEN", (char *)NULL); return TCL_ERROR; } @@ -2343,9 +2372,9 @@ Tcl_ExposeCommand( if (strstr(cmdName, "::") != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot expose to a namespace (use expose to toplevel, then rename)", - -1)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); + "cannot expose to a namespace (use expose to toplevel, then rename)", + TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "NON_GLOBAL", (char *)NULL); return TCL_ERROR; } @@ -2360,9 +2389,9 @@ Tcl_ExposeCommand( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unknown hidden command \"%s\"", hiddenCmdToken)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", - hiddenCmdToken, (char *)NULL); + "unknown hidden command \"%s\"", hiddenCmdToken)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", + hiddenCmdToken, (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); @@ -2381,7 +2410,7 @@ Tcl_ExposeCommand( Tcl_SetObjResult(interp, Tcl_NewStringObj( "trying to expose a non-global command namespace command", - -1)); + TCL_INDEX_NONE)); return TCL_ERROR; } @@ -2399,8 +2428,8 @@ Tcl_ExposeCommand( hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, cmdName, &isNew); if (!isNew) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "exposed command \"%s\" already exists", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); + "exposed command \"%s\" already exists", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "EXPOSE", "COMMAND_EXISTS", (char *)NULL); return TCL_ERROR; } @@ -2497,7 +2526,7 @@ Tcl_CreateCommand( * specified namespace; otherwise it is put in * the global namespace. */ Tcl_CmdProc *proc, /* Function to associate with cmdName. */ - void *clientData, /* Arbitrary value passed to string proc. */ + void *clientData, /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ @@ -2528,26 +2557,26 @@ Tcl_CreateCommand( */ while (1) { - /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; * otherwise, we always put it in the global namespace. - */ + */ - if (strstr(cmdName, "::") != NULL) { + if (strstr(cmdName, "::") != NULL) { Namespace *dummy1, *dummy2; TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; + return (Tcl_Command) NULL; } - } else { + } else { nsPtr = iPtr->globalNsPtr; tail = cmdName; - } + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); if (isNew || deleted) { /* @@ -2558,8 +2587,8 @@ Tcl_CreateCommand( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); @@ -2692,7 +2721,6 @@ typedef struct { Tcl_ObjCmdProc2 *nreProc; } CmdWrapperInfo; - static int cmdWrapperProc( void *clientData, @@ -2700,7 +2728,7 @@ cmdWrapperProc( int objc, Tcl_Obj * const *objv) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; if (objc < 0) { objc = -1; } @@ -2711,7 +2739,7 @@ static void cmdWrapperDeleteProc( void *clientData) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; clientData = info->deleteData; Tcl_CmdDeleteProc *deleteProc = info->deleteProc; @@ -2731,12 +2759,11 @@ Tcl_CreateObjCommand2( * the global namespace. */ Tcl_ObjCmdProc2 *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc + Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ -) { CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); info->proc = proc; @@ -2759,12 +2786,11 @@ Tcl_CreateObjCommand( * the global namespace. */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ - Tcl_CmdDeleteProc *deleteProc + Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ -) { Interp *iPtr = (Interp *) interp; Namespace *nsPtr; @@ -2805,11 +2831,11 @@ Tcl_Command TclCreateObjCommandInNs( Tcl_Interp *interp, const char *cmdName, /* Name of command, without any namespace - * components. */ - Tcl_Namespace *namesp, /* The namespace to create the command in */ + * components. */ + Tcl_Namespace *namesp, /* The namespace to create the command in */ Tcl_ObjCmdProc *proc, /* Object-based function to associate with * name. */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -2841,8 +2867,8 @@ TclCreateObjCommandInNs( } /* - * An existing command conflicts. Try to delete it... - */ + * An existing command conflicts. Try to delete it... + */ cmdPtr = (Command *)Tcl_GetHashValue(hPtr); @@ -2859,14 +2885,14 @@ TclCreateObjCommandInNs( } /* - * Make sure namespace doesn't get deallocated. - */ + * Make sure namespace doesn't get deallocated. + */ cmdPtr->nsPtr->refCount++; Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr); nsPtr = (Namespace *) TclEnsureNamespace(interp, - (Tcl_Namespace *) cmdPtr->nsPtr); + (Tcl_Namespace *) cmdPtr->nsPtr); TclNsDecrRefCount(cmdPtr->nsPtr); if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) { @@ -3052,10 +3078,10 @@ TclRenameCommand( cmdPtr = (Command *) cmd; if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't %s \"%s\": command doesn't exist", - ((newName == NULL)||(*newName == '\0'))? "delete":"rename", + "can't %s \"%s\": command doesn't exist", + ((newName == NULL) || (*newName == '\0')) ? "delete" : "rename", oldName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", oldName, (char *)NULL); return TCL_ERROR; } @@ -3085,16 +3111,16 @@ TclRenameCommand( if ((newNsPtr == NULL) || (newTail == NULL)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": bad command name", newName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); + "can't rename to \"%s\": bad command name", newName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", (char *)NULL); result = TCL_ERROR; goto done; } if (Tcl_FindHashEntry(&newNsPtr->cmdTable, newTail) != NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't rename to \"%s\": command already exists", newName)); - Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", - "TARGET_EXISTS", (char *)NULL); + "can't rename to \"%s\": command already exists", newName)); + Tcl_SetErrorCode(interp, "TCL", "OPERATION", "RENAME", + "TARGET_EXISTS", (char *)NULL); result = TCL_ERROR; goto done; } @@ -3165,11 +3191,11 @@ TclRenameCommand( */ Tcl_DStringInit(&newFullName); - Tcl_DStringAppend(&newFullName, newNsPtr->fullName, -1); + Tcl_DStringAppend(&newFullName, newNsPtr->fullName, TCL_INDEX_NONE); if (newNsPtr != iPtr->globalNsPtr) { TclDStringAppendLiteral(&newFullName, "::"); } - Tcl_DStringAppend(&newFullName, newTail, -1); + Tcl_DStringAppend(&newFullName, newTail, TCL_INDEX_NONE); cmdPtr->refCount++; CallCommandTraces(iPtr, cmdPtr, TclGetString(oldFullName), Tcl_DStringValue(&newFullName), TCL_TRACE_RENAME); @@ -3266,13 +3292,13 @@ Tcl_SetCommandInfo( static int invokeObj2Command( - void *clientData, /* Points to command's Command structure. */ + void *clientData, /* Points to command's Command structure. */ Tcl_Interp *interp, /* Current interpreter. */ Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { int result; - Command *cmdPtr = (Command *) clientData; + Command *cmdPtr = (Command *)clientData; if (objc > INT_MAX) { return TclCommandWordLimitError(interp, objc); @@ -3293,7 +3319,7 @@ cmdWrapper2Proc( Tcl_Size objc, Tcl_Obj *const objv[]) { - Command *cmdPtr = (Command *)clientData; + Command *cmdPtr = (Command *) clientData; if (objc > INT_MAX) { return TclCommandWordLimitError(interp, objc); } @@ -3330,7 +3356,7 @@ Tcl_SetCommandInfoFromToken( cmdPtr->objClientData = infoPtr->objClientData; } if (cmdPtr->deleteProc == cmdWrapperDeleteProc) { - CmdWrapperInfo *info = (CmdWrapperInfo *)cmdPtr->deleteData; + CmdWrapperInfo *info = (CmdWrapperInfo *) cmdPtr->deleteData; if (infoPtr->objProc2 == NULL) { info->proc = invokeObj2Command; info->clientData = cmdPtr; @@ -3535,14 +3561,14 @@ Tcl_GetCommandFullName( if ((cmdPtr != NULL) && TclRoutineHasName(cmdPtr)) { if (cmdPtr->nsPtr != NULL) { - Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, -1); + Tcl_AppendToObj(objPtr, cmdPtr->nsPtr->fullName, TCL_INDEX_NONE); if (cmdPtr->nsPtr != iPtr->globalNsPtr) { Tcl_AppendToObj(objPtr, "::", 2); } } if (cmdPtr->hPtr != NULL) { name = (char *)Tcl_GetHashKey(cmdPtr->hPtr->tablePtr, cmdPtr->hPtr); - Tcl_AppendToObj(objPtr, name, -1); + Tcl_AppendToObj(objPtr, name, TCL_INDEX_NONE); } } } @@ -3666,7 +3692,7 @@ Tcl_DeleteCommandFromToken( if (cmdPtr->tracePtr != NULL) { CommandTrace *tracePtr; /* CallCommandTraces() does not cmdPtr, that's - * done just before Tcl_DeleteCommandFromToken() returns */ + * done just before Tcl_DeleteCommandFromToken() returns */ CallCommandTraces(iPtr,cmdPtr,NULL,NULL,TCL_TRACE_DELETE); /* @@ -4043,7 +4069,7 @@ TclInterpReady( if (iPtr->flags & DELETED) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "attempt to call eval in deleted interpreter", -1)); + "attempt to call eval in deleted interpreter", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "IDELETE", "attempt to call eval in deleted interpreter", (char *)NULL); return TCL_ERROR; @@ -4072,7 +4098,7 @@ TclInterpReady( } Tcl_SetObjResult(interp, Tcl_NewStringObj( - "too many nested evaluations (infinite loop?)", -1)); + "too many nested evaluations (infinite loop?)", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "LIMIT", "STACK", (char *)NULL); return TCL_ERROR; } @@ -4150,7 +4176,7 @@ Tcl_Canceled( */ if (!TclCanceled(iPtr)) { - return TCL_OK; + return TCL_OK; } /* @@ -4171,7 +4197,7 @@ Tcl_Canceled( */ if ((flags & TCL_CANCEL_UNWIND) && !(iPtr->flags & TCL_CANCEL_UNWIND)) { - return TCL_OK; + return TCL_OK; } /* @@ -4180,34 +4206,34 @@ Tcl_Canceled( */ if (flags & TCL_LEAVE_ERR_MSG) { - const char *id, *message = NULL; - Tcl_Size length; + const char *id, *message = NULL; + Tcl_Size length; - /* - * Setup errorCode variables so that we can differentiate between - * being canceled and unwound. - */ + /* + * Setup errorCode variables so that we can differentiate between + * being canceled and unwound. + */ - if (iPtr->asyncCancelMsg != NULL) { - message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); - } else { - length = 0; - } + if (iPtr->asyncCancelMsg != NULL) { + message = TclGetStringFromObj(iPtr->asyncCancelMsg, &length); + } else { + length = 0; + } - if (iPtr->flags & TCL_CANCEL_UNWIND) { - id = "IUNWIND"; - if (length == 0) { - message = "eval unwound"; - } - } else { - id = "ICANCEL"; - if (length == 0) { - message = "eval canceled"; - } - } + if (iPtr->flags & TCL_CANCEL_UNWIND) { + id = "IUNWIND"; + if (length == 0) { + message = "eval unwound"; + } + } else { + id = "ICANCEL"; + if (length == 0) { + message = "eval canceled"; + } + } - Tcl_SetObjResult(interp, Tcl_NewStringObj(message, -1)); - Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj(message, TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "CANCEL", id, message, (char *)NULL); } /* @@ -4246,7 +4272,7 @@ Tcl_CancelEval( * script. */ Tcl_Obj *resultObjPtr, /* The script cancellation error message or * NULL for a default error message. */ - void *clientData, /* Passed to CancelEvalProc. */ + void *clientData, /* Passed to CancelEvalProc. */ int flags) /* Collection of OR-ed bits that control * the cancellation of the script. Only * TCL_CANCEL_UNWIND is currently @@ -4289,7 +4315,7 @@ Tcl_CancelEval( if (resultObjPtr != NULL) { result = TclGetStringFromObj(resultObjPtr, &cancelInfo->length); - cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result,cancelInfo->length); + cancelInfo->result = (char *)Tcl_Realloc(cancelInfo->result, cancelInfo->length); memcpy(cancelInfo->result, result, cancelInfo->length); TclDecrRefCount(resultObjPtr); /* Discard their result object. */ } else { @@ -4392,7 +4418,7 @@ TclNREvalObjv( */ if (iPtr->deferredCallbacks) { - iPtr->deferredCallbacks = NULL; + iPtr->deferredCallbacks = NULL; } else { TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL); } @@ -4411,7 +4437,7 @@ EvalObjvCore( { Command *cmdPtr = NULL, *preCmdPtr = (Command *)data[0]; int flags = PTR2INT(data[1]); - int objc = PTR2INT(data[2]); + Tcl_Size objc = PTR2INT(data[2]); Tcl_Obj **objv = (Tcl_Obj **)data[3]; Interp *iPtr = (Interp *) interp; Namespace *lookupNsPtr = NULL; @@ -4480,13 +4506,13 @@ EvalObjvCore( assert(cmdPtr == NULL); if (preCmdPtr) { /* - * Caller gave it to us. - */ + * Caller gave it to us. + */ if (!(preCmdPtr->flags & CMD_DEAD)) { /* - * So long as it exists, use it. - */ + * So long as it exists, use it. + */ cmdPtr = preCmdPtr; } else if (flags & TCL_EVAL_NORESOLVE) { @@ -4511,7 +4537,7 @@ EvalObjvCore( if (enterTracesDone || iPtr->tracePtr || (cmdPtr->flags & CMD_HAS_EXEC_TRACES)) { Tcl_Obj *commandPtr = TclGetSourceFromFrame( - flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, + flags & TCL_EVAL_SOURCE_IN_FRAME ? iPtr->cmdFramePtr : NULL, objc, objv); Tcl_IncrRefCount(commandPtr); @@ -4554,7 +4580,7 @@ EvalObjvCore( cmdPtr->refCount++; TclNRAddCallback(interp, TEOV_RunLeaveTraces, INT2PTR(objc), - commandPtr, cmdPtr, objv); + commandPtr, cmdPtr, objv); } TclNRAddCallback(interp, Dispatch, @@ -4617,8 +4643,8 @@ TclNRRunCallbacks( * are to be run. */ { while (TOP_CB(interp) != rootPtr) { - NRE_callback *callbackPtr = TOP_CB(interp); - Tcl_NRPostProc *procPtr = callbackPtr->procPtr; + NRE_callback *callbackPtr = TOP_CB(interp); + Tcl_NRPostProc *procPtr = callbackPtr->procPtr; TOP_CB(interp) = callbackPtr->nextPtr; result = procPtr(callbackPtr->data, interp, result); @@ -4638,9 +4664,9 @@ NRCommand( iPtr->numLevels--; - /* - * If there is a tailcall, schedule it next - */ + /* + * If there is a tailcall, schedule it next + */ if (data[1] && (data[1] != INT2PTR(1))) { listPtr = (Tcl_Obj *)data[1]; @@ -4684,7 +4710,7 @@ NRCommand( static void TEOV_PushExceptionHandlers( Tcl_Interp *interp, - int objc, + Tcl_Size objc, Tcl_Obj *const objv[], int flags) { @@ -4780,7 +4806,7 @@ TEOV_Error( Tcl_Obj *listPtr; const char *cmdString; Tcl_Size cmdLen; - int objc = PTR2INT(data[0]); + Tcl_Size objc = PTR2INT(data[0]); Tcl_Obj **objv = (Tcl_Obj **)data[1]; if ((result == TCL_ERROR) && !(iPtr->flags & ERR_ALREADY_LOGGED)) { @@ -4802,7 +4828,7 @@ TEOV_Error( static int TEOV_NotFound( Tcl_Interp *interp, - int objc, + Tcl_Size objc, Tcl_Obj *const objv[], Namespace *lookupNsPtr) { @@ -4855,7 +4881,7 @@ TEOV_NotFound( newObjv[i] = handlerObjv[i]; Tcl_IncrRefCount(newObjv[i]); } - memcpy(newObjv+handlerObjc, objv, sizeof(Tcl_Obj *) * objc); + memcpy(newObjv + handlerObjc, objv, sizeof(Tcl_Obj *) * objc); /* * Look up and invoke the handler (by recursive call to this function). If @@ -4870,9 +4896,9 @@ TEOV_NotFound( cmdPtr = TEOV_LookupCmdFromObj(interp, newObjv[0], lookupNsPtr); if (cmdPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid command name \"%s\"", TclGetString(objv[0]))); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", - TclGetString(objv[0]), (char *)NULL); + "invalid command name \"%s\"", TclGetString(objv[0]))); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COMMAND", + TclGetString(objv[0]), (char *)NULL); /* * Release any resources we locked and allocated during the handler @@ -4903,11 +4929,11 @@ TEOV_NotFoundCallback( int result) { Interp *iPtr = (Interp *) interp; - int objc = PTR2INT(data[0]); + Tcl_Size objc = PTR2INT(data[0]); Tcl_Obj **objv = (Tcl_Obj **)data[1]; Namespace *savedNsPtr = (Namespace *)data[2]; - int i; + Tcl_Size i; if (savedNsPtr) { iPtr->varFramePtr->nsPtr = savedNsPtr; @@ -4930,7 +4956,7 @@ TEOV_RunEnterTraces( Tcl_Interp *interp, Command **cmdPtrPtr, Tcl_Obj *commandPtr, - int objc, + Tcl_Size objc, Tcl_Obj *const objv[]) { Interp *iPtr = (Interp *) interp; @@ -4984,7 +5010,7 @@ TEOV_RunLeaveTraces( { Interp *iPtr = (Interp *) interp; int traceCode = TCL_OK; - int objc = PTR2INT(data[0]); + Tcl_Size objc = PTR2INT(data[0]); Tcl_Obj *commandPtr = (Tcl_Obj *)data[1]; Command *cmdPtr = (Command *)data[2]; Tcl_Obj **objv = (Tcl_Obj **)data[3]; @@ -5071,7 +5097,7 @@ Tcl_EvalTokensStandard( * errors. */ Tcl_Token *tokenPtr, /* Pointer to first in an array of tokens to * evaluate and concatenate. */ - Tcl_Size count) /* Number of tokens to consider at tokenPtr. + Tcl_Size count) /* Number of tokens to consider at tokenPtr. * Must be at least 1. */ { return TclSubstTokens(interp, tokenPtr, count, /* numLeftPtr */ NULL, 1, @@ -5126,7 +5152,7 @@ TclEvalEx( * evaluation of the script. Only * TCL_EVAL_GLOBAL is currently supported. */ Tcl_Size line, /* The line the script starts on. */ - Tcl_Size *clNextOuter, /* Information about an outer context for */ + Tcl_Size *clNextOuter, /* Information about an outer context for */ const char *outerScript) /* continuation line data. This is set only in * TclSubstTokens(), to properly handle * [...]-nested commands. The 'outerScript' @@ -5164,13 +5190,12 @@ TclEvalEx( * properly if an error occurs. */ Tcl_Parse *parsePtr = (Tcl_Parse *)TclStackAlloc(interp, sizeof(Tcl_Parse)); CmdFrame *eeFramePtr = (CmdFrame *)TclStackAlloc(interp, sizeof(CmdFrame)); - Tcl_Obj **stackObjArray = (Tcl_Obj **) - TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); + Tcl_Obj **stackObjArray = (Tcl_Obj **)TclStackAlloc(interp, minObjs * sizeof(Tcl_Obj *)); int *expandStack = (int *)TclStackAlloc(interp, minObjs * sizeof(int)); Tcl_Size *linesStack = (Tcl_Size *)TclStackAlloc(interp, minObjs * sizeof(Tcl_Size)); /* TIP #280 Structures for tracking of command * locations. */ - Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible + Tcl_Size *clNext = NULL; /* Pointer for the tracking of invisible * continuation lines. Initialized only if the * caller gave us a table of locations to * track, via scriptCLLocPtr. It always refers @@ -5303,9 +5328,11 @@ TclEvalEx( */ if (numWords > minObjs) { - expand = (int *)Tcl_Alloc(numWords * sizeof(int)); - objvSpace = (Tcl_Obj **)Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); - lineSpace = (Tcl_Size *)Tcl_Alloc(numWords * sizeof(Tcl_Size)); + expand = (int *)Tcl_Alloc(numWords * sizeof(int)); + objvSpace = (Tcl_Obj **) + Tcl_Alloc(numWords * sizeof(Tcl_Obj *)); + lineSpace = (Tcl_Size *) + Tcl_Alloc(numWords * sizeof(Tcl_Size)); } expandRequested = 0; objv = objvSpace; @@ -5314,7 +5341,7 @@ TclEvalEx( iPtr->cmdFramePtr = eeFramePtr->nextPtr; for (objectsUsed = 0, tokenPtr = parsePtr->tokenPtr; objectsUsed < numWords; - objectsUsed++, tokenPtr += tokenPtr->numComponents+1) { + objectsUsed++, tokenPtr += tokenPtr->numComponents + 1) { Tcl_Size additionalObjsCount; /* @@ -5337,7 +5364,7 @@ TclEvalEx( iPtr->evalFlags |= TCL_EVAL_FILE; } - code = TclSubstTokens(interp, tokenPtr+1, + code = TclSubstTokens(interp, tokenPtr + 1, tokenPtr->numComponents, NULL, wordLine, wordCLNext, outerScript); @@ -5402,8 +5429,7 @@ TclEvalEx( Tcl_Size objIdx = objectsNeeded - 1; if ((numWords > minObjs) || (objectsNeeded > minObjs)) { - objv = objvSpace = - (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); + objv = objvSpace = (Tcl_Obj **)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Obj *)); lines = lineSpace = (Tcl_Size *)Tcl_Alloc(objectsNeeded * sizeof(Tcl_Size)); } @@ -5428,7 +5454,7 @@ TclEvalEx( objectsUsed++; } } - objv += objIdx+1; + objv += objIdx + 1; if (copy != stackObjArray) { Tcl_Free(copy); @@ -5698,11 +5724,12 @@ void TclArgumentEnter( Tcl_Interp *interp, Tcl_Obj **objv, - int objc, + Tcl_Size objc, CmdFrame *cfPtr) { Interp *iPtr = (Interp *) interp; - int isNew, i; + int isNew; + Tcl_Size i; Tcl_HashEntry *hPtr; CFWord *cfwPtr; @@ -5766,15 +5793,14 @@ void TclArgumentRelease( Tcl_Interp *interp, Tcl_Obj **objv, - int objc) + Tcl_Size objc) { Interp *iPtr = (Interp *) interp; - int i; + Tcl_Size i; for (i = 1; i < objc; i++) { CFWord *cfwPtr; - Tcl_HashEntry *hPtr = - Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); + Tcl_HashEntry *hPtr = Tcl_FindHashEntry(iPtr->lineLAPtr, objv[i]); if (!hPtr) { continue; @@ -5814,19 +5840,18 @@ void TclArgumentBCEnter( Tcl_Interp *interp, Tcl_Obj *objv[], - int objc, + Tcl_Size objc, void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc) { ExtCmdLoc *eclPtr; - int word; + Tcl_Size word; ECL *ePtr; CFWordBC *lastPtr = NULL; Interp *iPtr = (Interp *) interp; - Tcl_HashEntry *hePtr = - Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); + Tcl_HashEntry *hePtr = Tcl_FindHashEntry(iPtr->lineBCPtr, codePtr); if (!hePtr) { return; @@ -5848,7 +5873,7 @@ TclArgumentBCEnter( */ if (ePtr->nline != objc) { - return; + return; } /* @@ -5866,7 +5891,7 @@ TclArgumentBCEnter( if (ePtr->line[word] >= 0) { int isNew; Tcl_HashEntry *hPtr = Tcl_CreateHashEntry(iPtr->lineLABCPtr, - objv[word], &isNew); + objv[word], &isNew); CFWordBC *cfwPtr = (CFWordBC *)Tcl_Alloc(sizeof(CFWordBC)); cfwPtr->framePtr = cfPtr; @@ -6056,7 +6081,7 @@ int Tcl_EvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - Tcl_Obj *objPtr, /* Pointer to object containing commands to + Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags) /* Collection of OR-ed bits that control the * evaluation of the script. Supported values @@ -6069,7 +6094,7 @@ int TclEvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - Tcl_Obj *objPtr, /* Pointer to object containing commands to + Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values @@ -6088,7 +6113,7 @@ int TclNREvalObjEx( Tcl_Interp *interp, /* Token for command interpreter (returned by * a previous call to Tcl_CreateInterp). */ - Tcl_Obj *objPtr, /* Pointer to object containing commands to + Tcl_Obj *objPtr, /* Pointer to object containing commands to * execute. */ int flags, /* Collection of OR-ed bits that control the * evaluation of the script. Supported values @@ -6173,7 +6198,7 @@ TclNREvalObjEx( } TclMarkTailcall(interp); - TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, + TclNRAddCallback(interp, TEOEx_ListCallback, listPtr, eoFramePtr, objPtr, NULL); TclListObjGetElements(NULL, listPtr, &objc, &objv); @@ -6194,9 +6219,9 @@ TclNREvalObjEx( * iPtr->varFramePtr in case * TCL_EVAL_GLOBAL was set. */ - if (TclInterpReady(interp) != TCL_OK) { - return TCL_ERROR; - } + if (TclInterpReady(interp) != TCL_OK) { + return TCL_ERROR; + } if (flags & TCL_EVAL_GLOBAL) { savedVarFramePtr = iPtr->varFramePtr; iPtr->varFramePtr = iPtr->rootFramePtr; @@ -6206,7 +6231,7 @@ TclNREvalObjEx( TclNRAddCallback(interp, TEOEx_ByteCodeCallback, savedVarFramePtr, objPtr, INT2PTR(allowExceptions), NULL); - return TclNRExecuteByteCode(interp, codePtr); + return TclNRExecuteByteCode(interp, codePtr); } { @@ -6356,10 +6381,10 @@ ProcessUnexpectedResult( Tcl_ResetResult(interp); if (returnCode == TCL_BREAK) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invoked \"break\" outside of a loop", -1)); + "invoked \"break\" outside of a loop", TCL_INDEX_NONE)); } else if (returnCode == TCL_CONTINUE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "invoked \"continue\" outside of a loop", -1)); + "invoked \"continue\" outside of a loop", TCL_INDEX_NONE)); } else { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "command returned bad code: %d", returnCode)); @@ -6405,7 +6430,7 @@ Tcl_ExprLong( *ptr = 0; } else { - exprPtr = Tcl_NewStringObj(exprstring, -1); + exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprLongObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); @@ -6430,7 +6455,7 @@ Tcl_ExprDouble( *ptr = 0.0; } else { - exprPtr = Tcl_NewStringObj(exprstring, -1); + exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprDoubleObj(interp, exprPtr, ptr); Tcl_DecrRefCount(exprPtr); @@ -6455,7 +6480,7 @@ Tcl_ExprBoolean( return TCL_OK; } else { int result; - Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, -1); + Tcl_Obj *exprPtr = Tcl_NewStringObj(exprstring, TCL_INDEX_NONE); Tcl_IncrRefCount(exprPtr); result = Tcl_ExprBooleanObj(interp, exprPtr, ptr); @@ -6489,7 +6514,7 @@ int Tcl_ExprLongObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ long *ptr) /* Where to store long result. */ { Tcl_Obj *resultPtr; @@ -6502,7 +6527,7 @@ Tcl_ExprLongObj( return TCL_ERROR; } - if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type)!=TCL_OK) { + if (Tcl_GetNumberFromObj(interp, resultPtr, &internalPtr, &type) != TCL_OK) { return TCL_ERROR; } @@ -6536,7 +6561,7 @@ int Tcl_ExprDoubleObj( Tcl_Interp *interp, /* Context in which to evaluate the * expression. */ - Tcl_Obj *objPtr, /* Expression to evaluate. */ + Tcl_Obj *objPtr, /* Expression to evaluate. */ double *ptr) /* Where to store double result. */ { Tcl_Obj *resultPtr; @@ -6612,7 +6637,7 @@ int TclObjInvokeNamespace( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ Tcl_Namespace *nsPtr, /* The namespace to use. */ @@ -6656,7 +6681,7 @@ int TclObjInvoke( Tcl_Interp *interp, /* Interpreter in which command is to be * invoked. */ - Tcl_Size objc, /* Count of arguments. */ + Tcl_Size objc, /* Count of arguments. */ Tcl_Obj *const objv[], /* Argument objects; objv[0] points to the * name of the command to invoke. */ int flags) /* Combination of flags controlling the call: @@ -6668,7 +6693,7 @@ TclObjInvoke( } if ((objc < 1) || (objv == NULL)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "illegal argument vector", -1)); + "illegal argument vector", TCL_INDEX_NONE)); return TCL_ERROR; } if ((flags & TCL_INVOKE_HIDDEN) == 0) { @@ -6697,9 +6722,9 @@ TclNRInvoke( } if (hPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "invalid hidden command name \"%s\"", cmdName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, - (char *)NULL); + "invalid hidden command name \"%s\"", cmdName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "HIDDENTOKEN", cmdName, + (char *)NULL); return TCL_ERROR; } cmdPtr = (Command *)Tcl_GetHashValue(hPtr); @@ -6767,7 +6792,7 @@ Tcl_ExprString( Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); } else { - Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, -1); + Tcl_Obj *resultPtr, *exprObj = Tcl_NewStringObj(expr, TCL_INDEX_NONE); Tcl_IncrRefCount(exprObj); code = Tcl_ExprObj(interp, exprObj, &resultPtr); @@ -6881,10 +6906,10 @@ Tcl_VarEval( if (string == NULL) { break; } - Tcl_DStringAppend(&buf, string, -1); + Tcl_DStringAppend(&buf, string, TCL_INDEX_NONE); } - result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), -1, 0); + result = Tcl_EvalEx(interp, Tcl_DStringValue(&buf), TCL_INDEX_NONE, 0); Tcl_DStringFree(&buf); return result; } @@ -7187,7 +7212,7 @@ ExprIsqrtFunc( negarg: Tcl_SetObjResult(interp, Tcl_NewStringObj( - "square root of negative argument", -1)); + "square root of negative argument", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "ARITH", "DOMAIN", "domain error: argument not in valid range", (char *)NULL); return TCL_ERROR; @@ -7247,7 +7272,7 @@ ExprSqrtFunc( static int ExprUnaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes one double argument and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7257,7 +7282,7 @@ ExprUnaryFunc( { int code; double d; - double (*func)(double) = (double (*)(double)) clientData; + BuiltinUnaryFunc *func = (BuiltinUnaryFunc *) clientData; if (objc != 2) { MathFuncWrongNumArgs(interp, 2, objc, objv); @@ -7311,7 +7336,7 @@ CheckDoubleResult( static int ExprBinaryFunc( - void *clientData, /* Contains the address of a function that + void *clientData, /* Contains the address of a function that * takes two double arguments and returns a * double result. */ Tcl_Interp *interp, /* The interpreter in which to execute the @@ -7321,7 +7346,7 @@ ExprBinaryFunc( { int code; double d1, d2; - double (*func)(double, double) = (double (*)(double, double)) clientData; + BuiltinBinaryFunc *func = (BuiltinBinaryFunc *)clientData; if (objc != 3) { MathFuncWrongNumArgs(interp, 3, objc, objv); @@ -7397,7 +7422,8 @@ ExprAbsFunc( Tcl_SetObjResult(interp, Tcl_NewWideIntObj(0)); return TCL_OK; } - bytes++; numBytes--; + bytes++; + numBytes--; } } goto unChanged; @@ -7615,20 +7641,20 @@ ExprMaxMinFunc( } res = objv[1]; for (i = 1; i < objc; i++) { - if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { - return TCL_ERROR; - } - if (type == TCL_NUMBER_NAN) { - /* - * Get the error message for NaN. - */ - - Tcl_GetDoubleFromObj(interp, objv[i], &d); - return TCL_ERROR; - } - if (TclCompareTwoNumbers(objv[i], res) == op) { - res = objv[i]; - } + if (Tcl_GetNumberFromObj(interp, objv[i], &ptr, &type) != TCL_OK) { + return TCL_ERROR; + } + if (type == TCL_NUMBER_NAN) { + /* + * Get the error message for NaN. + */ + + Tcl_GetDoubleFromObj(interp, objv[i], &d); + return TCL_ERROR; + } + if (TclCompareTwoNumbers(objv[i], res) == op) { + res = objv[i]; + } } Tcl_SetObjResult(interp, res); @@ -7684,7 +7710,7 @@ ExprRandFunc( * take into consideration the thread this interp is running in. */ - iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread())*4093U; + iPtr->randSeed = TclpGetClicks() + PTR2UINT(Tcl_GetCurrentThread()) * 4093U; /* * Make sure 1 <= randSeed <= (2^31) - 2. See below. @@ -7881,8 +7907,8 @@ ExprSrandFunc( * This page contains the functions that implement all of the built-in * math functions for classifying IEEE doubles. * - * These have to be a little bit careful while Tcl_GetDoubleFromObj() - * rejects NaN values, which these functions *explicitly* accept. + * These have to be a little bit careful while Tcl_GetDoubleFromObj() + * rejects NaN values, which these functions *explicitly* accept. * * Results: * Each function returns TCL_OK if it succeeds and pushes an Tcl object @@ -7916,16 +7942,16 @@ ClassifyDouble( * Hence we define those here. */ #ifndef FP_NAN -# define FP_NAN 1 /* Value is NaN */ -# define FP_INFINITE 2 /* Value is an infinity */ -# define FP_ZERO 3 /* Value is a zero */ -# define FP_NORMAL 4 /* Value is a normal float */ -# define FP_SUBNORMAL 5 /* Value has lost accuracy */ +# define FP_NAN 1 /* Value is NaN */ +# define FP_INFINITE 2 /* Value is an infinity */ +# define FP_ZERO 3 /* Value is a zero */ +# define FP_NORMAL 4 /* Value is a normal float */ +# define FP_SUBNORMAL 5 /* Value has lost accuracy */ #endif /* !FP_NAN */ #if TCL_FPCLASSIFY_MODE == 3 return __builtin_fpclassify( - FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); + FP_NAN, FP_INFINITE, FP_NORMAL, FP_SUBNORMAL, FP_ZERO, d); #elif TCL_FPCLASSIFY_MODE == 2 /* * We assume this hack is only needed on little-endian systems. @@ -7935,27 +7961,27 @@ ClassifyDouble( */ union { - double d; /* Interpret as double */ - struct { - unsigned int low; /* Lower 32 bits */ - unsigned int high; /* Upper 32 bits */ - } w; /* Interpret as unsigned integer words */ - } doubleMeaning; /* So we can look at the representation of a - * double directly. Platform (i.e., processor) - * specific; this is for x86 (and most other - * little-endian processors, but those are - * untested). */ + double d; /* Interpret as double */ + struct { + unsigned int low; /* Lower 32 bits */ + unsigned int high; /* Upper 32 bits */ + } w; /* Interpret as unsigned integer words */ + } doubleMeaning; /* So we can look at the representation of a + * double directly. Platform (i.e., processor) + * specific; this is for x86 (and most other + * little-endian processors, but those are + * untested). */ unsigned int exponent, mantissaLow, mantissaHigh; - /* The pieces extracted from the double. */ - int zeroMantissa; /* Was the mantissa zero? That's special. */ + /* The pieces extracted from the double. */ + int zeroMantissa; /* Was the mantissa zero? That's special. */ /* * Shifts and masks to use with the doubleMeaning variable above. */ -#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ -#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ -#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ +#define EXPONENT_MASK 0x7FF /* 11 bits (after shifting) */ +#define EXPONENT_SHIFT 20 /* Moves exponent to bottom of word */ +#define MANTISSA_MASK 0xFFFFF /* 20 bits (plus 32 from other word) */ /* * Extract the exponent (11 bits) and mantissa (52 bits). Note that we @@ -7974,43 +8000,43 @@ ClassifyDouble( switch (exponent) { case 0: - /* - * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. - */ + /* + * When the exponent is all zeros, it's a ZERO or a SUBNORMAL. + */ - return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; + return zeroMantissa ? FP_ZERO : FP_SUBNORMAL; case EXPONENT_MASK: - /* - * When the exponent is all ones, it's an INF or a NAN. - */ + /* + * When the exponent is all ones, it's an INF or a NAN. + */ - return zeroMantissa ? FP_INFINITE : FP_NAN; + return zeroMantissa ? FP_INFINITE : FP_NAN; default: - /* - * Everything else is a NORMAL double precision float. - */ + /* + * Everything else is a NORMAL double precision float. + */ - return FP_NORMAL; + return FP_NORMAL; } #elif TCL_FPCLASSIFY_MODE == 1 switch (_fpclass(d)) { case _FPCLASS_NZ: case _FPCLASS_PZ: - return FP_ZERO; + return FP_ZERO; case _FPCLASS_NN: case _FPCLASS_PN: - return FP_NORMAL; + return FP_NORMAL; case _FPCLASS_ND: case _FPCLASS_PD: - return FP_SUBNORMAL; + return FP_SUBNORMAL; case _FPCLASS_NINF: case _FPCLASS_PINF: - return FP_INFINITE; + return FP_INFINITE; default: - Tcl_Panic("result of _fpclass() outside documented range!"); + Tcl_Panic("result of _fpclass() outside documented range!"); case _FPCLASS_QNAN: case _FPCLASS_SNAN: - return FP_NAN; + return FP_NAN; } #else /* TCL_FPCLASSIFY_MODE not in (0..3) */ #error "unknown or unexpected TCL_FPCLASSIFY_MODE" @@ -8036,14 +8062,14 @@ ExprIsFiniteFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - type = ClassifyDouble(d); - result = (type != FP_INFINITE && type != FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + type = ClassifyDouble(d); + result = (type != FP_INFINITE && type != FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8067,13 +8093,13 @@ ExprIsInfinityFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_INFINITE); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_INFINITE); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8097,13 +8123,13 @@ ExprIsNaNFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NAN); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8127,13 +8153,13 @@ ExprIsNormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_NORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_NORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8157,13 +8183,13 @@ ExprIsSubnormalFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type != TCL_NUMBER_NAN) { - if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; - } - result = (ClassifyDouble(d) == FP_SUBNORMAL); + if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { + return TCL_ERROR; + } + result = (ClassifyDouble(d) == FP_SUBNORMAL); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); return TCL_OK; @@ -8187,23 +8213,23 @@ ExprIsUnorderedFunc( } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result = 1; + result = 1; } else { - d = *((const double *) ptr); - result = (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result = (ClassifyDouble(d) == FP_NAN); } if (Tcl_GetNumberFromObj(interp, objv[2], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - result |= 1; + result |= 1; } else { - d = *((const double *) ptr); - result |= (ClassifyDouble(d) == FP_NAN); + d = *((const double *) ptr); + result |= (ClassifyDouble(d) == FP_NAN); } Tcl_SetObjResult(interp, Tcl_NewBooleanObj(result)); @@ -8224,39 +8250,39 @@ FloatClassifyObjCmd( int type; if (objc != 2) { - Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); + Tcl_WrongNumArgs(interp, 1, objv, "floatValue"); return TCL_ERROR; } if (Tcl_GetNumberFromObj(interp, objv[1], &ptr, &type) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } if (type == TCL_NUMBER_NAN) { - goto gotNaN; + goto gotNaN; } else if (Tcl_GetDoubleFromObj(interp, objv[1], &d) != TCL_OK) { - return TCL_ERROR; + return TCL_ERROR; } switch (ClassifyDouble(d)) { case FP_INFINITE: - TclNewLiteralStringObj(objPtr, "infinite"); - break; + TclNewLiteralStringObj(objPtr, "infinite"); + break; case FP_NAN: gotNaN: - TclNewLiteralStringObj(objPtr, "nan"); - break; + TclNewLiteralStringObj(objPtr, "nan"); + break; case FP_NORMAL: - TclNewLiteralStringObj(objPtr, "normal"); - break; + TclNewLiteralStringObj(objPtr, "normal"); + break; case FP_SUBNORMAL: - TclNewLiteralStringObj(objPtr, "subnormal"); - break; + TclNewLiteralStringObj(objPtr, "subnormal"); + break; case FP_ZERO: - TclNewLiteralStringObj(objPtr, "zero"); - break; + TclNewLiteralStringObj(objPtr, "zero"); + break; default: - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "unable to classify number: %f", d)); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "unable to classify number: %f", d)); + return TCL_ERROR; } Tcl_SetObjResult(interp, objPtr); return TCL_OK; @@ -8289,10 +8315,10 @@ MathFuncWrongNumArgs( const char *name = TclGetString(objv[0]); const char *tail = name + strlen(name); - while (tail > name+1) { + while (tail > name + 1) { tail--; if (*tail == ':' && tail[-1] == ':') { - name = tail+1; + name = tail + 1; break; } } @@ -8487,14 +8513,14 @@ wrapperNRObjProc( int objc, Tcl_Obj *const objv[]) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; clientData = info->clientData; Tcl_ObjCmdProc2 *proc = info->proc; Tcl_Free(info); if (objc < 0) { objc = -1; } - return proc(clientData, interp, (Tcl_Size)objc, objv); + return proc(clientData, interp, (Tcl_Size) objc, objv); } int @@ -8555,7 +8581,8 @@ cmdWrapperNreProc( int objc, Tcl_Obj *const objv[]) { - CmdWrapperInfo *info = (CmdWrapperInfo *)clientData; + CmdWrapperInfo *info = (CmdWrapperInfo *) clientData; + if (objc < 0) { objc = -1; } @@ -8575,13 +8602,14 @@ Tcl_NRCreateCommand2( * calls. */ Tcl_ObjCmdProc2 *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when * this command is deleted. */ { CmdWrapperInfo *info = (CmdWrapperInfo *)Tcl_Alloc(sizeof(CmdWrapperInfo)); + info->proc = proc; info->clientData = clientData; info->nreProc = nreProc; @@ -8606,7 +8634,7 @@ Tcl_NRCreateCommand( * calls. */ Tcl_ObjCmdProc *nreProc, /* Object-based function to associate with * name, provides NR implementation */ - void *clientData, /* Arbitrary value to pass to object + void *clientData, /* Arbitrary value to pass to object * function. */ Tcl_CmdDeleteProc *deleteProc) /* If not NULL, gives a function to call when @@ -8614,7 +8642,7 @@ Tcl_NRCreateCommand( { Command *cmdPtr = (Command *) Tcl_CreateObjCommand(interp, cmdName, proc, clientData, - deleteProc); + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -8631,8 +8659,8 @@ TclNRCreateCommandInNs( Tcl_CmdDeleteProc *deleteProc) { Command *cmdPtr = (Command *) - TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, - deleteProc); + TclCreateObjCommandInNs(interp, cmdName, nsPtr, proc, clientData, + deleteProc); cmdPtr->nreProc = nreProc; return (Tcl_Command) cmdPtr; @@ -8655,7 +8683,7 @@ int Tcl_NREvalObjv( Tcl_Interp *interp, /* Interpreter in which to evaluate the * command. Also used for error reporting. */ - Tcl_Size objc, /* Number of words in command. */ + Tcl_Size objc, /* Number of words in command. */ Tcl_Obj *const objv[], /* An array of pointers to objects that are * the words that make up the command. */ int flags) /* Collection of OR-ed bits that control the @@ -8696,14 +8724,14 @@ Tcl_NRCmdSwap( * will execute. There are functions whose purpose is to help define the * precise spot: * TclMarkTailcall: if the NEXT command to be pushed tailcalls, execution - * should continue right here + * should continue right here * TclSkipTailcall: if the NEXT command to be pushed tailcalls, execution - * should continue after the CURRENT command is fully returned ("skip - * the next command: we are redirecting to it, tailcalls should run - * after WE return") + * should continue after the CURRENT command is fully returned ("skip + * the next command: we are redirecting to it, tailcalls should run + * after WE return") * TclPushTailcallPoint: the search for a tailcalling spot cannot traverse - * this point. This is special for OO, as some of the oo constructs - * that behave like commands may not push an NRCommand callback. + * this point. This is special for OO, as some of the oo constructs + * that behave like commands may not push an NRCommand callback. */ void @@ -8714,8 +8742,8 @@ TclMarkTailcall( if (iPtr->deferredCallbacks == NULL) { TclNRAddCallback(interp, NRCommand, NULL, NULL, - NULL, NULL); - iPtr->deferredCallbacks = TOP_CB(interp); + NULL, NULL); + iPtr->deferredCallbacks = TOP_CB(interp); } } @@ -8762,12 +8790,12 @@ TclSetTailcall( NRE_callback *runPtr; for (runPtr = TOP_CB(interp); runPtr; runPtr = runPtr->nextPtr) { - if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { - break; - } + if (((runPtr->procPtr) == NRCommand) && !runPtr->data[1]) { + break; + } } if (!runPtr) { - Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); + Tcl_Panic("tailcall cannot find the right splicing spot: should not happen!"); } runPtr->data[1] = listPtr; } @@ -8803,9 +8831,9 @@ TclNRTailcallObjCmd( } if (!(iPtr->varFramePtr->isProcCallFrame & 1)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "tailcall can only be called from a proc, lambda or method", -1)); - Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "tailcall can only be called from a proc, lambda or method", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "TAILCALL", "ILLEGAL", (char *)NULL); return TCL_ERROR; } @@ -8815,8 +8843,8 @@ TclNRTailcallObjCmd( */ if (iPtr->varFramePtr->tailcallPtr) { - Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); - iPtr->varFramePtr->tailcallPtr = NULL; + Tcl_DecrRefCount(iPtr->varFramePtr->tailcallPtr); + iPtr->varFramePtr->tailcallPtr = NULL; } /* @@ -8826,19 +8854,19 @@ TclNRTailcallObjCmd( */ if (objc > 1) { - Tcl_Obj *listPtr, *nsObjPtr; - Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; + Tcl_Obj *listPtr, *nsObjPtr; + Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr; - /* - * The tailcall data is in a Tcl list: the first element is the - * namespace, the rest the command to be tailcalled. - */ + /* + * The tailcall data is in a Tcl list: the first element is the + * namespace, the rest the command to be tailcalled. + */ - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); - listPtr = Tcl_NewListObj(objc, objv); + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); + listPtr = Tcl_NewListObj(objc, objv); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); - iPtr->varFramePtr->tailcallPtr = listPtr; + iPtr->varFramePtr->tailcallPtr = listPtr; } return TCL_RETURN; } @@ -8873,13 +8901,13 @@ TclNRTailcallEval( } if (result != TCL_OK) { - /* - * Tailcall execution was preempted, eg by an intervening catch or by - * a now-gone namespace: cleanup and return. - */ + /* + * Tailcall execution was preempted, eg by an intervening catch or by + * a now-gone namespace: cleanup and return. + */ Tcl_DecrRefCount(listPtr); - return result; + return result; } /* @@ -8889,7 +8917,7 @@ TclNRTailcallEval( TclMarkTailcall(interp); TclNRAddCallback(interp, TclNRReleaseValues, listPtr, NULL, NULL,NULL); iPtr->lookupNsPtr = (Namespace *) nsPtr; - return TclNREvalObjv(interp, objc-1, objv+1, 0, NULL); + return TclNREvalObjv(interp, objc - 1, objv + 1, 0, NULL); } int @@ -8966,7 +8994,7 @@ TclNRYieldObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yield can only be called in a coroutine", -1)); + "yield can only be called in a coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } @@ -8977,7 +9005,7 @@ TclNRYieldObjCmd( NRE_ASSERT(!COR_IS_SUSPENDED(corPtr)); TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - clientData, NULL, NULL); + clientData, NULL, NULL); return TCL_OK; } @@ -8999,17 +9027,17 @@ TclNRYieldToObjCmd( if (!corPtr) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto can only be called in a coroutine", -1)); + "yieldto can only be called in a coroutine", TCL_INDEX_NONE)); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", (char *)NULL); return TCL_ERROR; } if (((Namespace *) nsPtr)->flags & NS_DYING) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "yieldto called in deleted namespace", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "yieldto called in deleted namespace", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "YIELDTO_IN_DELETED", (char *)NULL); - return TCL_ERROR; + return TCL_ERROR; } /* @@ -9019,7 +9047,7 @@ TclNRYieldToObjCmd( */ listPtr = Tcl_NewListObj(objc, objv); - nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1); + nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, TCL_INDEX_NONE); TclListObjSetElement(interp, listPtr, 0, nsObjPtr); /* @@ -9174,14 +9202,14 @@ NRCoroutineExitCallback( * * TclNRCoroutineActivateCallback -- * - * This is the workhorse for coroutines: it implements both yield and - * resume. + * This is the workhorse for coroutines: it implements both yield and + * resume. * - * It is important that both be implemented in the same callback: the - * detection of the impossibility to suspend due to a busy C-stack relies - * on the precise position of a local variable in the stack. We do not - * want the compiler to play tricks on us, either by moving things around - * or inlining. + * It is important that both be implemented in the same callback: the + * detection of the impossibility to suspend due to a busy C-stack relies + * on the precise position of a local variable in the stack. We do not + * want the compiler to play tricks on us, either by moving things around + * or inlining. * *---------------------------------------------------------------------- */ @@ -9196,35 +9224,35 @@ TclNRCoroutineActivateCallback( void *stackLevel = TclGetCStackPtr(); if (!corPtr->stackLevel) { - /* - * -- Coroutine is suspended -- - * Push the callback to restore the caller's context on yield or - * return. - */ - - TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); - - /* - * Record the stackLevel at which the resume is happening, then swap - * the interp's environment to make it suitable to run this coroutine. - */ - - corPtr->stackLevel = stackLevel; - Tcl_Size numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = iPtr->numLevels; - - SAVE_CONTEXT(corPtr->caller); - corPtr->callerEEPtr = iPtr->execEnvPtr; - RESTORE_CONTEXT(corPtr->running); - iPtr->execEnvPtr = corPtr->eePtr; - iPtr->numLevels += numLevels; + /* + * -- Coroutine is suspended -- + * Push the callback to restore the caller's context on yield or + * return. + */ + + TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, + NULL, NULL, NULL); + + /* + * Record the stackLevel at which the resume is happening, then swap + * the interp's environment to make it suitable to run this coroutine. + */ + + corPtr->stackLevel = stackLevel; + Tcl_Size numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = iPtr->numLevels; + + SAVE_CONTEXT(corPtr->caller); + corPtr->callerEEPtr = iPtr->execEnvPtr; + RESTORE_CONTEXT(corPtr->running); + iPtr->execEnvPtr = corPtr->eePtr; + iPtr->numLevels += numLevels; } else { - /* - * Coroutine is active: yield - */ + /* + * Coroutine is active: yield + */ - if (corPtr->stackLevel != stackLevel) { + if (corPtr->stackLevel != stackLevel) { NRE_callback *runPtr; iPtr->execEnvPtr = corPtr->callerEEPtr; @@ -9240,31 +9268,30 @@ TclNRCoroutineActivateCallback( } iPtr->execEnvPtr = corPtr->eePtr; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "cannot yield: C stack busy", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", + (char *)NULL); + return TCL_ERROR; + } - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "cannot yield: C stack busy", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD", - (char *)NULL); - return TCL_ERROR; - } - - void *type = data[1]; - if (type == CORO_ACTIVATE_YIELD) { - corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; - } else if (type == CORO_ACTIVATE_YIELDM) { - corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; - } else { - Tcl_Panic("Yield received an option which is not implemented"); - } + void *type = data[1]; + if (type == CORO_ACTIVATE_YIELD) { + corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL; + } else if (type == CORO_ACTIVATE_YIELDM) { + corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY; + } else { + Tcl_Panic("Yield received an option which is not implemented"); + } corPtr->yieldPtr = NULL; - corPtr->stackLevel = NULL; + corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return TCL_OK; @@ -9275,7 +9302,7 @@ TclNRCoroutineActivateCallback( * * TclNREvalList -- * - * Callback to invoke command as list, used in order to delayed + * Callback to invoke command as list, used in order to delayed * processing of canonical list command in sane environment. * *---------------------------------------------------------------------- @@ -9304,7 +9331,7 @@ TclNREvalList( * * CoroTypeObjCmd -- * - * Implementation of [::tcl::unsupported::corotype] command. + * Implementation of [::tcl::unsupported::corotype] command. * *---------------------------------------------------------------------- */ @@ -9330,11 +9357,11 @@ CoroTypeObjCmd( cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only get coroutine type of a coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objv[1]), (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only get coroutine type of a coroutine", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objv[1]), (char *)NULL); + return TCL_ERROR; } /* @@ -9344,8 +9371,8 @@ CoroTypeObjCmd( corPtr = (CoroutineData *)cmdPtr->objClientData; if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("active", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("active", TCL_INDEX_NONE)); + return TCL_OK; } /* @@ -9355,16 +9382,16 @@ CoroTypeObjCmd( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yield", TCL_INDEX_NONE)); + return TCL_OK; case COROUTINE_ARGUMENTS_ARBITRARY: - Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", -1)); - return TCL_OK; + Tcl_SetObjResult(interp, Tcl_NewStringObj("yieldto", TCL_INDEX_NONE)); + return TCL_OK; default: - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "unknown coroutine type", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unknown coroutine type", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BAD_TYPE", (char *)NULL); + return TCL_ERROR; } } @@ -9373,7 +9400,7 @@ CoroTypeObjCmd( * * TclNRCoroInjectObjCmd, TclNRCoroProbeObjCmd -- * - * Implementation of [coroinject] and [coroprobe] commands. + * Implementation of [coroinject] and [coroprobe] commands. * *---------------------------------------------------------------------- */ @@ -9391,10 +9418,10 @@ GetCoroutineFromObj( Command *cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objPtr); if ((!cmdPtr) || (cmdPtr->nreProc != TclNRInterpCoroutine)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, -1)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", - TclGetString(objPtr), (char *)NULL); - return NULL; + Tcl_SetObjResult(interp, Tcl_NewStringObj(errMsg, TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE", + TclGetString(objPtr), (char *)NULL); + return NULL; } return (CoroutineData *)cmdPtr->objClientData; } @@ -9419,15 +9446,15 @@ TclNRCoroInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9438,7 +9465,7 @@ TclNRCoroInjectObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -9464,16 +9491,16 @@ TclNRCoroProbeObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a probe command into a coroutine"); + "can only inject a probe command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a probe command into a suspended coroutine", - -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a probe command into a suspended coroutine", + TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9484,7 +9511,7 @@ TclNRCoroProbeObjCmd( ExecEnv *savedEEPtr = iPtr->execEnvPtr; iPtr->execEnvPtr = corPtr->eePtr; TclNRAddCallback(interp, InjectHandler, corPtr, - Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); + Tcl_NewListObj(objc - 2, objv + 2), INT2PTR(corPtr->nargs), corPtr); iPtr->execEnvPtr = savedEEPtr; /* @@ -9495,7 +9522,7 @@ TclNRCoroProbeObjCmd( */ TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); /* * Record the stackLevel at which the resume is happening, then swap @@ -9523,18 +9550,18 @@ TclNRCoroProbeObjCmd( * * InjectHandler, InjectHandlerPostProc -- * - * Part of the implementation of [coroinject] and [coroprobe]. These are - * run inside the context of the coroutine being injected/probed into. + * Part of the implementation of [coroinject] and [coroprobe]. These are + * run inside the context of the coroutine being injected/probed into. * - * InjectHandler runs a script (possibly adding arguments) in the context - * of the coroutine. The script is specified as a one-shot list (with - * reference count equal to 1) in data[1]. This function also arranges - * for InjectHandlerPostProc to be the part that runs after the script - * completes. + * InjectHandler runs a script (possibly adding arguments) in the context + * of the coroutine. The script is specified as a one-shot list (with + * reference count equal to 1) in data[1]. This function also arranges + * for InjectHandlerPostProc to be the part that runs after the script + * completes. * - * InjectHandlerPostProc cleans up after InjectHandler (deleting the - * list) and, for the [coroprobe] command *only*, yields back to the - * caller context (i.e., where [coroprobe] was run). + * InjectHandlerPostProc cleans up after InjectHandler (deleting the + * list) and, for the [coroprobe] command *only*, yields back to the + * caller context (i.e., where [coroprobe] was run). *s *---------------------------------------------------------------------- */ @@ -9581,7 +9608,7 @@ InjectHandler( Tcl_IncrRefCount(listPtr); TclMarkTailcall(interp); TclNRAddCallback(interp, InjectHandlerPostCall, corPtr, listPtr, - INT2PTR(nargs), isProbe); + INT2PTR(nargs), isProbe); TclListObjGetElements(NULL, listPtr, &objc, &objv); return TclNREvalObjv(interp, objc, objv, 0, NULL); } @@ -9611,16 +9638,16 @@ InjectHandlerPostCall( */ if (isProbe) { - if (result == TCL_ERROR) { - Tcl_AddErrorInfo(interp, - "\n (injected coroutine probe command)"); - } - corPtr->nargs = nargs; - corPtr->stackLevel = NULL; - Tcl_Size numLevels = iPtr->numLevels; - iPtr->numLevels = corPtr->auxNumLevels; - corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; - iPtr->execEnvPtr = corPtr->callerEEPtr; + if (result == TCL_ERROR) { + Tcl_AddErrorInfo(interp, + "\n (injected coroutine probe command)"); + } + corPtr->nargs = nargs; + corPtr->stackLevel = NULL; + Tcl_Size numLevels = iPtr->numLevels; + iPtr->numLevels = corPtr->auxNumLevels; + corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels; + iPtr->execEnvPtr = corPtr->callerEEPtr; } return result; } @@ -9630,7 +9657,7 @@ InjectHandlerPostCall( * * NRInjectObjCmd -- * - * Implementation of [::tcl::unsupported::inject] command. + * Implementation of [::tcl::unsupported::inject] command. * *---------------------------------------------------------------------- */ @@ -9656,15 +9683,15 @@ NRInjectObjCmd( } corPtr = GetCoroutineFromObj(interp, objv[1], - "can only inject a command into a coroutine"); + "can only inject a command into a coroutine"); if (!corPtr) { - return TCL_ERROR; + return TCL_ERROR; } if (!COR_IS_SUSPENDED(corPtr)) { - Tcl_SetObjResult(interp, Tcl_NewStringObj( - "can only inject a command into a suspended coroutine", -1)); - Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); - return TCL_ERROR; + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "can only inject a command into a suspended coroutine", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", (char *)NULL); + return TCL_ERROR; } /* @@ -9673,8 +9700,8 @@ NRInjectObjCmd( */ iPtr->execEnvPtr = corPtr->eePtr; - TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc-2, objv+2), - NULL, NULL, NULL); + TclNRAddCallback(interp, TclNREvalList, Tcl_NewListObj(objc - 2, objv + 2), + NULL, NULL, NULL); iPtr->execEnvPtr = savedEEPtr; return TCL_OK; @@ -9691,8 +9718,8 @@ TclNRInterpCoroutine( if (!COR_IS_SUSPENDED(corPtr)) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "coroutine \"%s\" is already running", - TclGetString(objv[0]))); + "coroutine \"%s\" is already running", + TclGetString(objv[0]))); Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "BUSY", (char *)NULL); return TCL_ERROR; } @@ -9705,31 +9732,31 @@ TclNRInterpCoroutine( switch (corPtr->nargs) { case COROUTINE_ARGUMENTS_SINGLE_OPTIONAL: - if (objc == 2) { - Tcl_SetObjResult(interp, objv[1]); - } else if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); - return TCL_ERROR; - } - break; + if (objc == 2) { + Tcl_SetObjResult(interp, objv[1]); + } else if (objc > 2) { + Tcl_WrongNumArgs(interp, 1, objv, "?arg?"); + return TCL_ERROR; + } + break; default: - if (corPtr->nargs + 1 != objc) { - Tcl_SetObjResult(interp, - Tcl_NewStringObj("wrong coro nargs; how did we get here? " - "not implemented!", -1)); - Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); - return TCL_ERROR; - } - /* fallthrough */ + if (corPtr->nargs + 1 != objc) { + Tcl_SetObjResult(interp, + Tcl_NewStringObj("wrong coro nargs; how did we get here? " + "not implemented!", TCL_INDEX_NONE)); + Tcl_SetErrorCode(interp, "TCL", "WRONGARGS", (char *)NULL); + return TCL_ERROR; + } + /* fallthrough */ case COROUTINE_ARGUMENTS_ARBITRARY: - if (objc > 1) { - Tcl_SetObjResult(interp, Tcl_NewListObj(objc-1, objv+1)); - } - break; + if (objc > 1) { + Tcl_SetObjResult(interp, Tcl_NewListObj(objc - 1, objv + 1)); + } + break; } TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } @@ -9738,8 +9765,8 @@ TclNRInterpCoroutine( * * TclNRCoroutineObjCmd -- * - * Implementation of [coroutine] command; see documentation for - * description of what this does. + * Implementation of [coroutine] command; see documentation for + * description of what this does. * *---------------------------------------------------------------------- */ @@ -9769,16 +9796,16 @@ TclNRCoroutineObjCmd( if (nsPtr == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": unknown namespace", - procName)); - Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); + "can't create procedure \"%s\": unknown namespace", + procName)); + Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "NAMESPACE", (char *)NULL); return TCL_ERROR; } if (simpleName == NULL) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "can't create procedure \"%s\": bad procedure name", - procName)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); + "can't create procedure \"%s\": bad procedure name", + procName)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMMAND", procName, (char *)NULL); return TCL_ERROR; } @@ -9870,7 +9897,7 @@ TclNRCoroutineObjCmd( */ TclNRAddCallback(interp, TclNRCoroutineActivateCallback, corPtr, - NULL, NULL, NULL); + NULL, NULL, NULL); return TCL_OK; } diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 329cfe2..d95452b 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -557,7 +557,6 @@ TclNarrowToBytes( Tcl_IncrRefCount(objPtr); return objPtr; } - /* *---------------------------------------------------------------------- diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index 1c12106..a95fc83 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -719,7 +719,6 @@ Tcl_AttemptDbCkrealloc( Tcl_DbCkfree(ptr, file, line); return newPtr; } - /* *---------------------------------------------------------------------- @@ -1010,7 +1009,6 @@ Tcl_InitMemory( Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL); } - #else /* TCL_MEM_DEBUG */ /* This is the !TCL_MEM_DEBUG case */ @@ -1018,7 +1016,6 @@ Tcl_InitMemory( #undef Tcl_InitMemory #undef Tcl_DumpActiveMemory #undef Tcl_ValidateAllMemory - /* *---------------------------------------------------------------------- @@ -1253,11 +1250,11 @@ TclDumpMemoryInfo( */ void * TclAllocElemsEx( - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr = TclAttemptReallocElemsEx( NULL, elemCount, elemSize, leadSize, capacityPtr); @@ -1288,13 +1285,13 @@ TclAllocElemsEx( */ void * TclAttemptReallocElemsEx( - void *oldPtr, /* Pointer to memory block to reallocate or - * NULL to indicate this is a new allocation */ - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + void *oldPtr, /* Pointer to memory block to reallocate or + * NULL to indicate this is a new allocation */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr; Tcl_Size limit; @@ -1358,12 +1355,12 @@ TclAttemptReallocElemsEx( */ void * TclReallocElemsEx( - void *oldPtr, /* Pointer to memory block to reallocate */ - Tcl_Size elemCount, /* Allocation will store at least these many... */ - Tcl_Size elemSize, /* ...elements of this size */ - Tcl_Size leadSize, /* Additional leading space in bytes */ - Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored - here if non-NULL. Only modified on success */ + void *oldPtr, /* Pointer to memory block to reallocate */ + Tcl_Size elemCount, /* Allocation will store at least these many... */ + Tcl_Size elemSize, /* ...elements of this size */ + Tcl_Size leadSize, /* Additional leading space in bytes */ + Tcl_Size *capacityPtr) /* OUTPUT: Actual capacity is stored here if + * non-NULL. Only modified on success */ { void *ptr = TclAttemptReallocElemsEx( oldPtr, elemCount, elemSize, leadSize, capacityPtr); diff --git a/generic/tclClock.c b/generic/tclClock.c index 2cfa4a5..4d7df19 100644 --- a/generic/tclClock.c +++ b/generic/tclClock.c @@ -83,8 +83,7 @@ static int ConvertLocalToUTCUsingTable(Tcl_Interp *, Tcl_WideInt *rangesVal); static int ConvertLocalToUTCUsingC(Tcl_Interp *, TclDateFields *, int); -static int ClockConfigureObjCmd(void *clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); +static Tcl_ObjCmdProc ClockConfigureObjCmd; static void GetYearWeekDay(TclDateFields *, int); static void GetGregorianEraYearDay(TclDateFields *, int); static void GetMonthDay(TclDateFields *); @@ -941,7 +940,8 @@ TimezoneLoaded( * * ClockConfigureObjCmd -- * - * This function is invoked to process the Tcl "::clock::configure" (internal) command. + * This function is invoked to process the Tcl "::tcl::unsupported::clock::configure" + * (internal, unsupported) command. * * Usage: * ::tcl::unsupported::clock::configure ?-option ?value?? @@ -964,19 +964,16 @@ ClockConfigureObjCmd( { ClockClientData *dataPtr = (ClockClientData *)clientData; static const char *const options[] = { - "-system-tz", "-setup-tz", "-default-locale", "-current-locale", - "-clear", + "-default-locale", "-clear", "-current-locale", "-year-century", "-century-switch", "-min-year", "-max-year", "-max-jdn", "-validate", - "-init-complete", - NULL + "-init-complete", "-setup-tz", "-system-tz", NULL }; enum optionInd { - CLOCK_SYSTEM_TZ, CLOCK_SETUP_TZ, CLOCK_DEFAULT_LOCALE, CLOCK_CURRENT_LOCALE, - CLOCK_CLEAR_CACHE, + CLOCK_DEFAULT_LOCALE, CLOCK_CLEAR_CACHE, CLOCK_CURRENT_LOCALE, CLOCK_YEAR_CENTURY, CLOCK_CENTURY_SWITCH, CLOCK_MIN_YEAR, CLOCK_MAX_YEAR, CLOCK_MAX_JDN, CLOCK_VALIDATE, - CLOCK_INIT_COMPLETE + CLOCK_INIT_COMPLETE, CLOCK_SETUP_TZ, CLOCK_SYSTEM_TZ }; int optionIndex; /* Index of an option. */ Tcl_Size i; @@ -1964,7 +1961,6 @@ ConvertLocalToUTC( ltzoc->tzOffset = fields->tzOffset; } - /* check DST-hole: if retrieved seconds is out of range */ if (ltzoc->rangesVal[0] > seconds || seconds >= ltzoc->rangesVal[1]) { dstHole: @@ -2900,7 +2896,6 @@ GetJulianDayFromEraYearMonthDay( *---------------------------------------------------------------------- */ - void GetJulianDayFromEraYearDay( TclDateFields *fields, /* Date to convert */ @@ -4250,7 +4245,6 @@ ClockCalcRelTime( return TCL_OK; } - /*---------------------------------------------------------------------- * @@ -4309,8 +4303,6 @@ ClockWeekdaysOffs( return offs; } - - /*---------------------------------------------------------------------- * @@ -4571,16 +4563,16 @@ ClockSafeCatchCmd( Tcl_Obj *const objv[]) { typedef struct { - int status; /* return code status */ - int flags; /* Each remaining field saves the */ - int returnLevel; /* corresponding field of the Interp */ - int returnCode; /* struct. These fields taken together are */ - Tcl_Obj *errorInfo; /* the "state" of the interp. */ - Tcl_Obj *errorCode; - Tcl_Obj *returnOpts; - Tcl_Obj *objResult; - Tcl_Obj *errorStack; - int resetErrorStack; + int status; /* return code status */ + int flags; /* Each remaining field saves the */ + int returnLevel; /* corresponding field of the Interp */ + int returnCode; /* struct. These fields taken together are */ + Tcl_Obj *errorInfo; /* the "state" of the interp. */ + Tcl_Obj *errorCode; + Tcl_Obj *returnOpts; + Tcl_Obj *objResult; + Tcl_Obj *errorStack; + int resetErrorStack; } InterpState; Interp *iPtr = (Interp *)interp; diff --git a/generic/tclClockFmt.c b/generic/tclClockFmt.c index 140ecdd..a50b43f 100644 --- a/generic/tclClockFmt.c +++ b/generic/tclClockFmt.c @@ -249,7 +249,7 @@ Clock_itoaw( val /= 10; *p-- = '0' + c; } while (val > 0); - /* fulling with pad-char */ + /* filling with pad-char */ while (p >= buf) { *p-- = padchar; } @@ -290,7 +290,7 @@ Clock_itoaw( if (padchar != '0') { *p-- = '-'; } - /* fulling with pad-char */ + /* filling with pad-char */ while (p >= buf + 1) { *p-- = padchar; } @@ -347,7 +347,7 @@ Clock_witoaw( val /= 10; *p-- = '0' + c; } while (val > 0); - /* fulling with pad-char */ + /* filling with pad-char */ while (p >= buf) { *p-- = padchar; } @@ -398,7 +398,7 @@ Clock_witoaw( if (padchar != '0') { *p-- = '-'; } - /* fulling with pad-char */ + /* filling with pad-char */ while (p >= buf + 1) { *p-- = padchar; } @@ -2140,16 +2140,13 @@ EstimateTokenCount( return ++tokcnt; } -#define AllocTokenInChain(tok, chain, tokCnt, type) \ - if (++(tok) >= (chain) + (tokCnt)) { \ - chain = (type)Tcl_AttemptRealloc((char *)(chain), \ +#define AllocTokenInChain(tok, chain, tokCnt, type) \ + if (++(tok) >= (chain) + (tokCnt)) { \ + chain = (type)Tcl_Realloc((char *)(chain), \ (tokCnt + CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE) * sizeof(*(tok))); \ - if ((chain) == NULL) { \ - goto done; \ - } \ - (tok) = (chain) + (tokCnt); \ - (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ - } \ + (tok) = (chain) + (tokCnt); \ + (tokCnt) += CLOCK_MIN_TOK_CHAIN_BLOCK_SIZE; \ + } \ memset(tok, 0, sizeof(*(tok))); /* @@ -2282,7 +2279,7 @@ ClockGetOrParseScanFormat( continue; } default: - if (*p == ' ' || isspace(UCHAR(*p))) { + if (isspace(UCHAR(*p))) { tok->map = &ScnSpaceTokenMap; tok->tokWord.start = p++; while (p < e && isspace(UCHAR(*p))) { @@ -2296,28 +2293,33 @@ ClockGetOrParseScanFormat( tokCnt++; continue; } - word_tok: - { - ClockScanToken *wordTok = tok; - - if (tok > scnTok && (tok - 1)->map == &ScnWordTokenMap) { - wordTok = tok - 1; - } - /* new word token */ - if (wordTok == tok) { + word_tok: + { + /* try continue with previous word token */ + ClockScanToken *wordTok = tok - 1; + + if (wordTok < scnTok || wordTok->map != &ScnWordTokenMap) { + /* start with new word token */ + wordTok = tok; wordTok->tokWord.start = p; wordTok->map = &ScnWordTokenMap; + } + + do { + if (isspace(UCHAR(*p))) { + fss->scnSpaceCount++; + } + p = Tcl_UtfNext(p); + } while (p < e && *p != '%'); + wordTok->tokWord.end = p; + + if (wordTok == tok) { AllocTokenInChain(tok, scnTok, fss->scnTokC, ClockScanToken *); tokCnt++; } - if (isspace(UCHAR(*p))) { - fss->scnSpaceCount++; } - p = Tcl_UtfNext(p); - wordTok->tokWord.end = p; break; } - } } /* calculate end distance value for each tokens */ @@ -2349,9 +2351,8 @@ ClockGetOrParseScanFormat( fss->scnTok = scnTok; fss->scnTokC = tokCnt; } - done: - Tcl_MutexUnlock(&ClockFmtMutex); + Tcl_MutexUnlock(&ClockFmtMutex); return fss; } @@ -3335,23 +3336,29 @@ ClockGetOrParseFmtFormat( continue; } default: - word_tok: { - ClockFormatToken *wordTok = tok; - - if (tok > fmtTok && (tok - 1)->map == &FmtWordTokenMap) { - wordTok = tok - 1; - } - if (wordTok == tok) { + word_tok: + { + /* try continue with previous word token */ + ClockFormatToken *wordTok = tok - 1; + + if (wordTok < fmtTok || wordTok->map != &FmtWordTokenMap) { + /* start with new word token */ + wordTok = tok; wordTok->tokWord.start = p; wordTok->map = &FmtWordTokenMap; + } + do { + p = Tcl_UtfNext(p); + } while (p < e && *p != '%'); + wordTok->tokWord.end = p; + + if (wordTok == tok) { AllocTokenInChain(tok, fmtTok, fss->fmtTokC, ClockFormatToken *); tokCnt++; } - p = Tcl_UtfNext(p); - wordTok->tokWord.end = p; + } break; } - } } /* correct count of real used tokens and free mem if desired @@ -3367,7 +3374,7 @@ ClockGetOrParseFmtFormat( fss->fmtTok = fmtTok; fss->fmtTokC = tokCnt; } - done: + Tcl_MutexUnlock(&ClockFmtMutex); return fss; } @@ -3560,7 +3567,7 @@ ClockFrmScnClearCaches(void) } void -ClockFrmScnFinalize() +ClockFrmScnFinalize(void) { if (!initialized) { return; diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c index 288271b..ab5fbb0 100644 --- a/generic/tclCmdAH.c +++ b/generic/tclCmdAH.c @@ -425,14 +425,13 @@ TclInitEncodingCmd( */ static int EncodingConvertParseOptions( - Tcl_Interp *interp, /* For error messages. May be NULL */ - int objc, /* Number of arguments */ - Tcl_Obj *const objv[], /* Argument objects as passed to command. */ - Tcl_Encoding *encPtr, /* Where to store the encoding */ - Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ - int *profilePtr, /* Bit mask of encoding option profile */ - Tcl_Obj **failVarPtr /* Where to store -failindex option value */ -) + Tcl_Interp *interp, /* For error messages. May be NULL */ + int objc, /* Number of arguments */ + Tcl_Obj *const objv[], /* Argument objects as passed to command. */ + Tcl_Encoding *encPtr, /* Where to store the encoding */ + Tcl_Obj **dataObjPtr, /* Where to store ptr to Tcl_Obj containing data */ + int *profilePtr, /* Bit mask of encoding option profile */ + Tcl_Obj **failVarPtr) /* Where to store -failindex option value */ { static const char *const options[] = {"-profile", "-failindex", NULL}; enum convertfromOptions { PROFILE, FAILINDEX } optIndex; diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index c46ab60..37c9822 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.c @@ -5290,7 +5290,6 @@ SortCompare( return 0; } - objPtr1 = elemPtr1->collationKey.objValuePtr; objPtr2 = elemPtr2->collationKey.objValuePtr; diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 99a97ad..bad58f6 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -657,7 +657,6 @@ TclCompileCatchCmd( } ExceptionRangeEnds(envPtr, range); - /* * Emit the "no errors" epilogue: push "0" (TCL_OK) as the catch result, * and jump around the "error case" code. @@ -679,7 +678,6 @@ TclCompileCatchCmd( TclEmitOpcode( INST_POP, envPtr); } - /* Stack at this point is empty */ TclEmitOpcode( INST_PUSH_RESULT, envPtr); TclEmitOpcode( INST_PUSH_RETURN_CODE, envPtr); @@ -791,7 +789,6 @@ TclCompileClockClicksCmd( } return TCL_OK; } - /*---------------------------------------------------------------------- * @@ -2851,7 +2848,6 @@ CompileEachloopCmd( int varIndex; Tcl_Size length; - Tcl_ListObjIndex(NULL, varListObj, j, &varNameObj); bytes = TclGetStringFromObj(varNameObj, &length); varIndex = LocalScalar(bytes, length, envPtr); diff --git a/generic/tclCompCmdsSZ.c b/generic/tclCompCmdsSZ.c index 98a39f9..bc37155 100644 --- a/generic/tclCompCmdsSZ.c +++ b/generic/tclCompCmdsSZ.c @@ -101,7 +101,6 @@ const AuxDataType tclJumptableInfoType = { if ((idx)<256) {OP1(STORE_SCALAR1,(idx));} else {OP4(STORE_SCALAR4,(idx));} #define INVOKE(name) \ TclEmitInvoke(envPtr,INST_##name) - /* *---------------------------------------------------------------------- diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index c9f9ec5..5c46afd 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -1924,7 +1924,7 @@ ParseLexeme( unsigned char *lexemePtr, /* Write code of parsed lexeme to this * storage. */ Tcl_Obj **literalPtr) /* Write corresponding literal value to this - storage, if non-NULL. */ + * storage, if non-NULL. */ { const char *end; int ch; diff --git a/generic/tclCompile.h b/generic/tclCompile.h index 5bbbb8f..18d5ed7 100644 --- a/generic/tclCompile.h +++ b/generic/tclCompile.h @@ -89,20 +89,20 @@ typedef enum { typedef struct { ExceptionRangeType type; /* The kind of ExceptionRange. */ - Tcl_Size nestingLevel; /* Static depth of the exception range. Used + Tcl_Size nestingLevel; /* Static depth of the exception range. Used * to find the most deeply-nested range * surrounding a PC at runtime. */ - Tcl_Size codeOffset; /* Offset of the first instruction byte of the + Tcl_Size codeOffset; /* Offset of the first instruction byte of the * code range. */ - Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ - Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC + Tcl_Size numCodeBytes; /* Number of bytes in the code range. */ + Tcl_Size breakOffset; /* If LOOP_EXCEPTION_RANGE, the target PC * offset for a break command in the range. */ - Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, the - * target PC offset for a continue command in - * the code range. Otherwise, ignore this + Tcl_Size continueOffset; /* If LOOP_EXCEPTION_RANGE and not TCL_INDEX_NONE, + * the target PC offset for a continue command + * in the code range. Otherwise, ignore this * range when processing a continue * command. */ - Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC + Tcl_Size catchOffset; /* If a CATCH_EXCEPTION_RANGE, the target PC * offset for any "exception" in range. */ } ExceptionRange; @@ -118,11 +118,11 @@ typedef struct ExceptionAux { * one (see [for] next-clause) then we must * not pick up the range when scanning for a * target to continue to. */ - Tcl_Size stackDepth; /* The stack depth at the point where the + Tcl_Size stackDepth; /* The stack depth at the point where the * exception range was created. This is used * to calculate the number of POPs required to * restore the stack to its prior state. */ - Tcl_Size expandTarget; /* The number of expansions expected on the + Tcl_Size expandTarget; /* The number of expansions expected on the * auxData stack at the time the loop starts; * we can't currently discard them except by * doing INST_INVOKE_EXPANDED; this is a known @@ -135,23 +135,25 @@ typedef struct ExceptionAux { Tcl_Size numBreakTargets; /* The number of [break]s that want to be * targeted to the place where this loop * exception will be bound to. */ - TCL_HASH_TYPE *breakTargets; /* The offsets of the INST_JUMP4 instructions + TCL_HASH_TYPE *breakTargets;/* The offsets of the INST_JUMP4 instructions * issued by the [break]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numBreakTargets==0, this is NULL. */ Tcl_Size allocBreakTargets; /* The size of the breakTargets array. */ - Tcl_Size numContinueTargets; /* The number of [continue]s that want to be + Tcl_Size numContinueTargets;/* The number of [continue]s that want to be * targeted to the place where this loop * exception will be bound to. */ - TCL_HASH_TYPE *continueTargets; /* The offsets of the INST_JUMP4 instructions + TCL_HASH_TYPE *continueTargets; + /* The offsets of the INST_JUMP4 instructions * issued by the [continue]s that we must * update. Note that resizing a jump (via * TclFixupForwardJump) can cause the contents * of this array to be updated. When * numContinueTargets==0, this is NULL. */ - Tcl_Size allocContinueTargets; /* The size of the continueTargets array. */ + Tcl_Size allocContinueTargets; + /* The size of the continueTargets array. */ } ExceptionAux; /* @@ -163,10 +165,10 @@ typedef struct ExceptionAux { */ typedef struct { - Tcl_Size codeOffset; /* Offset of first byte of command code. */ - Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ + Tcl_Size codeOffset; /* Offset of first byte of command code. */ + Tcl_Size numCodeBytes; /* Number of bytes for command's code. */ Tcl_Size srcOffset; /* Offset of first char of the command. */ - Tcl_Size numSrcBytes; /* Number of command source chars. */ + Tcl_Size numSrcBytes; /* Number of command source chars. */ } CmdLocation; /* @@ -182,10 +184,10 @@ typedef struct { typedef struct { Tcl_Size srcOffset; /* Command location to find the entry. */ - Tcl_Size nline; /* Number of words in the command */ - Tcl_Size *line; /* Line information for all words in the + Tcl_Size nline; /* Number of words in the command */ + Tcl_Size *line; /* Line information for all words in the * command. */ - Tcl_Size **next; /* Transient information used by the compiler + Tcl_Size **next; /* Transient information used by the compiler * for tracking of hidden continuation * lines. */ } ECL; @@ -198,8 +200,8 @@ typedef struct { Tcl_Obj *path; /* Path of the sourced file the command is * in. */ ECL *loc; /* Command word locations (lines). */ - Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ - Tcl_Size nuloc; /* Number of used entries in 'loc'. */ + Tcl_Size nloc; /* Number of allocated entries in 'loc'. */ + Tcl_Size nuloc; /* Number of used entries in 'loc'. */ } ExtCmdLoc; /* @@ -217,11 +219,11 @@ typedef struct { * the AuxData structure. */ -typedef void *(AuxDataDupProc) (void *clientData); -typedef void (AuxDataFreeProc) (void *clientData); -typedef void (AuxDataPrintProc)(void *clientData, - Tcl_Obj *appendObj, struct ByteCode *codePtr, - TCL_HASH_TYPE pcOffset); +typedef void * (AuxDataDupProc) (void *clientData); +typedef void (AuxDataFreeProc) (void *clientData); +typedef void (AuxDataPrintProc) (void *clientData, + Tcl_Obj *appendObj, struct ByteCode *codePtr, + TCL_HASH_TYPE pcOffset); /* * We define a separate AuxDataType struct to hold type-related information @@ -266,7 +268,7 @@ typedef struct AuxDataType { typedef struct AuxData { const AuxDataType *type; /* Pointer to the AuxData type associated with * this ClientData. */ - void *clientData; /* The compilation data itself. */ + void *clientData; /* The compilation data itself. */ } AuxData; /* @@ -290,21 +292,23 @@ typedef struct CompileEnv { * SetByteCodeFromAny. This pointer is not * owned by the CompileEnv and must not be * freed or changed by it. */ - Tcl_Size numSrcBytes; /* Number of bytes in source. */ + Tcl_Size numSrcBytes; /* Number of bytes in source. */ Proc *procPtr; /* If a procedure is being compiled, a pointer * to its Proc structure; otherwise NULL. Used * to compile local variables. Set from * information provided by ObjInterpProc in * tclProc.c. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size exceptDepth; /* Current exception range nesting level; TCL_INDEX_NONE - * if not in any range currently. */ - Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; TCL_INDEX_NONE - * if no ranges have been compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size exceptDepth; /* Current exception range nesting level; + * TCL_INDEX_NONE if not in any range + * currently. */ + Tcl_Size maxExceptDepth; /* Max nesting level of exception ranges; + * TCL_INDEX_NONE if no ranges have been + * compiled. */ + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. Set by compilation * procedures before returning. */ - Tcl_Size currStackDepth; /* Current stack depth. */ + Tcl_Size currStackDepth; /* Current stack depth. */ LiteralTable localLitTable; /* Contains LiteralEntry's describing all Tcl * objects referenced by this compiled code. * Indexed by the string representations of @@ -333,7 +337,7 @@ typedef struct CompileEnv { * exceptArrayNext is the number of ranges and * (exceptArrayNext-1) is the index of the * current range's array entry. */ - Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array + Tcl_Size exceptArrayEnd; /* Index after the last ExceptionRange array * entry. */ #if TCL_MAJOR_VERSION < 9 int mallocedExceptArray; @@ -379,7 +383,7 @@ typedef struct CompileEnv { /* TIP #280 */ ExtCmdLoc *extCmdMapPtr; /* Extended command location information for * 'info frame'. */ - Tcl_Size line; /* First line of the script, based on the + Tcl_Size line; /* First line of the script, based on the * invoking context, then the line of the * command currently compiled. */ int atCmdStart; /* Flag to say whether an INST_START_CMD @@ -388,11 +392,11 @@ typedef struct CompileEnv { * inefficient. If set to 2, that instruction * should not be issued at all (by the generic * part of the command compiler). */ - Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions + Tcl_Size expandCount; /* Number of INST_EXPAND_START instructions * encountered that have not yet been paired * with a corresponding * INST_INVOKE_EXPANDED. */ - Tcl_Size *clNext; /* If not NULL, it refers to the next slot in + Tcl_Size *clNext; /* If not NULL, it refers to the next slot in * clLoc to check for an invisible * continuation line. */ } CompileEnv; @@ -427,7 +431,7 @@ typedef struct ByteCode { * procs are specific to an interpreter so the * code emitted will depend on the * interpreter. */ - Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this + Tcl_Size compileEpoch; /* Value of iPtr->compileEpoch when this * ByteCode was compiled. Used to invalidate * code when, e.g., commands with compile * procs are redefined. */ @@ -459,17 +463,17 @@ typedef struct ByteCode { * itself. Does not include heap space for * literal Tcl objects or storage referenced * by AuxData entries. */ - Tcl_Size numCommands; /* Number of commands compiled. */ - Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ - Tcl_Size numCodeBytes; /* Number of code bytes. */ - Tcl_Size numLitObjects; /* Number of objects in literal array. */ + Tcl_Size numCommands; /* Number of commands compiled. */ + Tcl_Size numSrcBytes; /* Number of source bytes compiled. */ + Tcl_Size numCodeBytes; /* Number of code bytes. */ + Tcl_Size numLitObjects; /* Number of objects in literal array. */ Tcl_Size numExceptRanges; /* Number of ExceptionRange array elems. */ Tcl_Size numAuxDataItems; /* Number of AuxData items. */ - Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command + Tcl_Size numCmdLocBytes; /* Number of bytes needed for encoded command * location information. */ - Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; + Tcl_Size maxExceptDepth; /* Maximum nesting level of ExceptionRanges; * TCL_INDEX_NONE if no ranges were compiled. */ - Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to + Tcl_Size maxStackDepth; /* Maximum number of stack elements needed to * execute the code. */ unsigned char *codeStart; /* Points to the first byte of the code. This * is just after the final ByteCode member @@ -525,7 +529,7 @@ typedef struct ByteCode { #endif /* TCL_COMPILE_STATS */ } ByteCode; -#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \ +#define ByteCodeSetInternalRep(objPtr, typePtr, codePtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (codePtr); \ @@ -533,13 +537,11 @@ typedef struct ByteCode { Tcl_StoreInternalRep((objPtr), (typePtr), &ir); \ } while (0) - - -#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ +#define ByteCodeGetInternalRep(objPtr, typePtr, codePtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ - (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), (typePtr)); \ + (codePtr) = irPtr ? (ByteCode*)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -829,11 +831,11 @@ enum TclInstruction { INST_DICT_GET_DEF, - /* TIP 461 */ - INST_STR_LT, - INST_STR_GT, - INST_STR_LE, - INST_STR_GE, + /* TIP 461 */ + INST_STR_LT, + INST_STR_GT, + INST_STR_LE, + INST_STR_GE, INST_LREPLACE4, @@ -968,8 +970,8 @@ typedef struct JumpFixup { typedef struct JumpFixupArray { JumpFixup *fixup; /* Points to start of jump fixup array. */ - Tcl_Size next; /* Index of next free array entry. */ - Tcl_Size end; /* Index of last usable entry in array. */ + Tcl_Size next; /* Index of next free array entry. */ + Tcl_Size end; /* Index of last usable entry in array. */ int mallocedArray; /* 1 if array was expanded and fixups points * into the heap, else 0. */ JumpFixup staticFixupSpace[JUMPFIXUP_INIT_ENTRIES]; @@ -985,7 +987,8 @@ typedef struct JumpFixupArray { typedef struct ForeachVarList { Tcl_Size numVars; /* The number of variables in the list. */ - Tcl_Size varIndexes[TCLFLEXARRAY];/* An array of the indexes ("slot numbers") + Tcl_Size varIndexes[TCLFLEXARRAY]; + /* An array of the indexes ("slot numbers") * for each variable in the procedure's array * of local variables. Only scalar variables * are supported. The actual size of this @@ -1003,13 +1006,14 @@ typedef struct ForeachVarList { typedef struct ForeachInfo { Tcl_Size numLists; /* The number of both the variable and value * lists of the foreach command. */ - Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame + Tcl_Size firstValueTemp; /* Index of the first temp var in a proc frame * used to point to a value list. */ - Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding + Tcl_Size loopCtTemp; /* Index of temp var in a proc frame holding * the loop's iteration count. Used to * determine next value list element to assign * each loop var. */ - ForeachVarList *varLists[TCLFLEXARRAY];/* An array of pointers to ForeachVarList + ForeachVarList *varLists[TCLFLEXARRAY]; + /* An array of pointers to ForeachVarList * structures describing each var list. The * actual size of this field will be large * enough to numVars indexes. THIS MUST BE THE @@ -1040,7 +1044,8 @@ MODULE_SCOPE const AuxDataType tclJumptableInfoType; typedef struct { Tcl_Size length; /* Size of array */ - Tcl_Size varIndices[TCLFLEXARRAY]; /* Array of variable indices to manage when + Tcl_Size varIndices[TCLFLEXARRAY]; + /* Array of variable indices to manage when * processing the start and end of a [dict * update]. There is really more than one * entry, and the structure is allocated to @@ -1200,14 +1205,13 @@ MODULE_SCOPE void TclLogCommandInfo(Tcl_Interp *interp, const char *script, const char *command, Tcl_Size length, const unsigned char *pc, Tcl_Obj **tosPtr); -MODULE_SCOPE Tcl_Obj *TclGetInnerContext(Tcl_Interp *interp, +MODULE_SCOPE Tcl_Obj * TclGetInnerContext(Tcl_Interp *interp, const unsigned char *pc, Tcl_Obj **tosPtr); -MODULE_SCOPE Tcl_Obj *TclNewInstNameObj(unsigned char inst); +MODULE_SCOPE Tcl_Obj * TclNewInstNameObj(unsigned char inst); MODULE_SCOPE int TclPushProcCallFrame(void *clientData, Tcl_Interp *interp, Tcl_Size objc, Tcl_Obj *const objv[], int isLambda); #endif /* TCL_MAJOR_VERSION > 8 */ - /* *---------------------------------------------------------------- @@ -1230,58 +1234,66 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #define LITERAL_UNSHARED 0x04 /* - * Macro used to manually adjust the stack requirements; used in cases where - * the stack effect cannot be computed from the opcode and its operands, but - * is still known at compile time. - * - * void TclAdjustStackDepth(int delta, CompileEnv *envPtr); + * Adjust the stack requirements. Manually used in cases where the stack + * effect cannot be computed from the opcode and its operands, but is still + * known at compile time. */ +static inline void +TclAdjustStackDepth( + int delta, + CompileEnv *envPtr) +{ + if (delta < 0) { + if ((int) envPtr->maxStackDepth < (int) envPtr->currStackDepth) { + envPtr->maxStackDepth = envPtr->currStackDepth; + } + } + envPtr->currStackDepth += delta; +} -#define TclAdjustStackDepth(delta, envPtr) \ - do { \ - if ((delta) < 0) { \ - if ((int)(envPtr)->maxStackDepth < (int)(envPtr)->currStackDepth) { \ - (envPtr)->maxStackDepth = (envPtr)->currStackDepth; \ - } \ - } \ - (envPtr)->currStackDepth += (delta); \ - } while (0) - -#define TclGetStackDepth(envPtr) \ +#define TclGetStackDepth(envPtr) \ ((envPtr)->currStackDepth) -#define TclSetStackDepth(depth, envPtr) \ +#define TclSetStackDepth(depth, envPtr) \ (envPtr)->currStackDepth = (depth) -#define TclCheckStackDepth(depth, envPtr) \ - do { \ - size_t _dd = (depth); \ - if (_dd != (size_t)(envPtr)->currStackDepth) { \ - Tcl_Panic("bad stack depth computations: is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", \ - (size_t)(envPtr)->currStackDepth, _dd); \ - } \ - } while (0) +/* + * Verify that the current stack depth is what we think it should be. When + * this is wrong, code generation is broken! + */ +static inline void +TclCheckStackDepth( + size_t depth, + CompileEnv *envPtr) +{ + if (depth != (size_t) envPtr->currStackDepth) { + Tcl_Panic("bad stack depth computations: " + "is %" TCL_Z_MODIFIER "u, should be %" TCL_Z_MODIFIER "u", + (size_t) envPtr->currStackDepth, depth); + } +} /* - * Macro used to update the stack requirements. It is called by the macros - * TclEmitOpCode, TclEmitInst1 and TclEmitInst4. + * Update the stack requirements based on the instruction definition. It is + * called by the macros TclEmitOpCode, TclEmitInst1 and TclEmitInst4. * Remark that the very last instruction of a bytecode always reduces the * stack level: INST_DONE or INST_POP, so that the maxStackdepth is always * updated. - * - * void TclUpdateStackReqs(unsigned char op, int i, CompileEnv *envPtr); */ - -#define TclUpdateStackReqs(op, i, envPtr) \ - do { \ - int _delta = tclInstructionTable[(op)].stackEffect; \ - if (_delta) { \ - if (_delta == INT_MIN) { \ - _delta = 1 - (i); \ - } \ - TclAdjustStackDepth(_delta, envPtr); \ - } \ - } while (0) +static inline void +TclUpdateStackReqs( + unsigned char op, + int i, + CompileEnv *envPtr) +{ + int delta = tclInstructionTable[op].stackEffect; + if (delta) { + if (delta == INT_MIN) { + delta = 1 - i; + } + TclAdjustStackDepth(delta, envPtr); + } +} /* * Macros used to update the flag that indicates if we are at the start of a @@ -1291,8 +1303,8 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclUpdateAtCmdStart(op, envPtr) \ - if ((envPtr)->atCmdStart < 2) { \ - (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ + if ((envPtr)->atCmdStart < 2) { \ + (envPtr)->atCmdStart = ((op) == INST_START_CMD ? 1 : 0); \ } /* @@ -1303,13 +1315,13 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclEmitOpcode(op, envPtr) \ - do { \ - if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, 0, envPtr); \ + do { \ + if ((envPtr)->codeNext == (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + TclUpdateAtCmdStart(op, envPtr); \ + TclUpdateStackReqs(op, 0, envPtr); \ } while (0) /* @@ -1365,21 +1377,21 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, } while (0) #define TclEmitInstInt4(op, i, envPtr) \ - do { \ - if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ - TclExpandCodeArray(envPtr); \ - } \ - *(envPtr)->codeNext++ = (unsigned char) (op); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 24); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 16); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) >> 8); \ - *(envPtr)->codeNext++ = \ - (unsigned char) ((unsigned int) (i) ); \ - TclUpdateAtCmdStart(op, envPtr); \ - TclUpdateStackReqs(op, i, envPtr); \ + do { \ + if (((envPtr)->codeNext + 5) > (envPtr)->codeEnd) { \ + TclExpandCodeArray(envPtr); \ + } \ + *(envPtr)->codeNext++ = (unsigned char) (op); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 24); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 16); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) >> 8); \ + *(envPtr)->codeNext++ = \ + (unsigned char) ((unsigned int) (i) ); \ + TclUpdateAtCmdStart(op, envPtr); \ + TclUpdateStackReqs(op, i, envPtr); \ } while (0) /* @@ -1392,13 +1404,13 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclEmitPush(objIndex, envPtr) \ - do { \ - int _objIndexCopy = (objIndex); \ - if (_objIndexCopy <= 255) { \ - TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ - } else { \ - TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ - } \ + do { \ + int _objIndexCopy = (objIndex); \ + if (_objIndexCopy <= 255) { \ + TclEmitInstInt1(INST_PUSH1, _objIndexCopy, (envPtr)); \ + } else { \ + TclEmitInstInt4(INST_PUSH4, _objIndexCopy, (envPtr)); \ + } \ } while (0) /* @@ -1414,11 +1426,11 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, *(p) = (unsigned char) ((unsigned int) (i)) #define TclStoreInt4AtPtr(i, p) \ - do { \ - *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ - *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ - *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ - *(p+3) = (unsigned char) ((unsigned int) (i) ); \ + do { \ + *(p) = (unsigned char) ((unsigned int) (i) >> 24); \ + *(p+1) = (unsigned char) ((unsigned int) (i) >> 16); \ + *(p+2) = (unsigned char) ((unsigned int) (i) >> 8); \ + *(p+3) = (unsigned char) ((unsigned int) (i) ); \ } while (0) /* @@ -1431,15 +1443,15 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, */ #define TclUpdateInstInt1AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt1AtPtr((i), ((pc)+1)); \ + do { \ + *(pc) = (unsigned char) (op); \ + TclStoreInt1AtPtr((i), ((pc)+1)); \ } while (0) #define TclUpdateInstInt4AtPc(op, i, pc) \ - do { \ - *(pc) = (unsigned char) (op); \ - TclStoreInt4AtPtr((i), ((pc)+1)); \ + do { \ + *(pc) = (unsigned char) (op); \ + TclStoreInt4AtPtr((i), ((pc)+1)); \ } while (0) /* @@ -1486,17 +1498,17 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, #endif #define TclGetInt4AtPtr(p) \ - ((int) ((TclGetUInt1AtPtr(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ + ((int) ((TclGetUInt1AtPtr(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ (*((p)+3)))) #define TclGetUInt1AtPtr(p) \ ((unsigned int) *(p)) #define TclGetUInt4AtPtr(p) \ - ((unsigned int) ((*(p) << 24) | \ - (*((p)+1) << 16) | \ - (*((p)+2) << 8) | \ + ((unsigned int) ((*(p) << 24) | \ + (*((p)+1) << 16) | \ + (*((p)+2) << 8) | \ (*((p)+3)))) /* @@ -1517,7 +1529,7 @@ MODULE_SCOPE int TclPushProcCallFrame(void *clientData, * static void BODY(Tcl_Token *tokenPtr, int word); */ -#define BODY(tokenPtr, word) \ +#define BODY(tokenPtr, word) \ SetLineInformation((word)); \ TclCompileCmdWord(interp, (tokenPtr)+1, (tokenPtr)->numComponents, \ envPtr) @@ -1815,14 +1827,14 @@ MODULE_SCOPE void TclDTraceOpenDebugLog(void); MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *argsi); #define TCL_DTRACE_DEBUG_LOG() \ - int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ - int tclDTraceDebugIndent = 0; \ - FILE *tclDTraceDebugLog = NULL; \ - void TclDTraceOpenDebugLog(void) { \ - char n[35]; \ + int tclDTraceDebugEnabled = TCL_DTRACE_DEBUG_LOG_ENABLED; \ + int tclDTraceDebugIndent = 0; \ + FILE *tclDTraceDebugLog = NULL; \ + void TclDTraceOpenDebugLog(void) { \ + char n[35]; \ snprintf(n, sizeof(n), "/tmp/tclDTraceDebug-%" TCL_Z_MODIFIER "u.log", \ - (size_t) getpid()); \ - tclDTraceDebugLog = fopen(n, "a"); \ + (size_t) getpid()); \ + tclDTraceDebugLog = fopen(n, "a"); \ } #define TclDTraceDbgMsg(p, m, ...) \ @@ -1849,10 +1861,10 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args #define TCL_DTRACE_PROC_ARGS_ENABLED() 1 #define TCL_DTRACE_PROC_INFO_ENABLED() 1 #define TCL_DTRACE_PROC_ENTRY(a0, a1, a2) \ - tclDTraceDebugIndent++; \ + tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> proc-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_PROC_RETURN(a0, a1) \ - TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ + TclDTraceDbgMsg("<- proc-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_PROC_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | proc-result", "%s %d %s %p", a0, a1, a2, a3) @@ -1869,10 +1881,10 @@ MODULE_SCOPE void TclDTraceInfo(Tcl_Obj *info, const char **args, Tcl_Size *args #define TCL_DTRACE_CMD_ARGS_ENABLED() 1 #define TCL_DTRACE_CMD_INFO_ENABLED() 1 #define TCL_DTRACE_CMD_ENTRY(a0, a1, a2) \ - tclDTraceDebugIndent++; \ + tclDTraceDebugIndent++; \ TclDTraceDbgMsg("-> cmd-entry", "%s %" TCL_SIZE_MODIFIER "d %p", a0, a1, a2) #define TCL_DTRACE_CMD_RETURN(a0, a1) \ - TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ + TclDTraceDbgMsg("<- cmd-return", "%s %d", a0, a1); \ tclDTraceDebugIndent-- #define TCL_DTRACE_CMD_RESULT(a0, a1, a2, a3) \ TclDTraceDbgMsg(" | cmd-result", "%s %d %s %p", a0, a1, a2, a3) diff --git a/generic/tclDecls.h b/generic/tclDecls.h index 73ab405..19b044a 100644 --- a/generic/tclDecls.h +++ b/generic/tclDecls.h @@ -4032,34 +4032,40 @@ extern const TclStubs *tclStubsPtr; #undef Tcl_GetIndexFromObjStruct #undef Tcl_GetBooleanFromObj #undef Tcl_GetBoolean -#if !defined(__cplusplus) && !defined(BUILD_tcl) && !defined(BUILD_tk) && !defined(_MSC_VER) +#if !defined(TCLBOOLWARNING) +#if !defined(__cplusplus) && !defined(BUILD_tcl) && !defined(BUILD_tk) && defined(__STDC_VERSION__) && (__STDC_VERSION__ >= 201112L) # define TCLBOOLWARNING(boolPtr) (void)(sizeof(struct {_Static_assert(sizeof(*(boolPtr)) <= sizeof(int), "sizeof(boolPtr) too large");int dummy;})), -#elif defined(__GNUC__) +#elif defined(__GNUC__) && !defined(__STRICT_ANSI__) /* If this gives: "error: size of array ‘_bool_Var’ is negative", it means that sizeof(*boolPtr)>sizeof(int), which is not allowed */ -# define TCLBOOLWARNING(boolPtr) ({__attribute__((unused)) char _bool_Var[sizeof(*(boolPtr)) > sizeof(int) ? -1 : 1];}), +# define TCLBOOLWARNING(boolPtr) ({__attribute__((unused)) char _bool_Var[sizeof(*(boolPtr)) <= sizeof(int) ? 1 : -1];}), #else # define TCLBOOLWARNING(boolPtr) #endif +#endif /* !TCLBOOLWARNING */ #if defined(USE_TCL_STUBS) #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ (tclStubsPtr->tcl_GetIndexFromObjStruct((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ - (TCLBOOLWARNING(boolPtr)(sizeof(*(boolPtr)) >= sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ - Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \ + (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))) #define Tcl_GetBoolean(interp, src, boolPtr) \ - (TCLBOOLWARNING(boolPtr)(sizeof(*(boolPtr)) >= sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ - Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? tclStubsPtr->tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \ + (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))) #else #define Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, indexPtr) \ ((Tcl_GetIndexFromObjStruct)((interp), (objPtr), (tablePtr), (offset), (msg), \ (flags)|(int)(sizeof(*(indexPtr))<<1), (indexPtr))) #define Tcl_GetBooleanFromObj(interp, objPtr, boolPtr) \ - (TCLBOOLWARNING(boolPtr)(sizeof(*(boolPtr)) >= sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ - Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBooleanFromObj(interp, objPtr, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBoolFromObj(interp, objPtr, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \ + (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))) #define Tcl_GetBoolean(interp, src, boolPtr) \ - (TCLBOOLWARNING(boolPtr)(sizeof(*(boolPtr)) >= sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ - Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr))) + ((sizeof(*(boolPtr)) == sizeof(int) && (TCL_MAJOR_VERSION == 8)) ? Tcl_GetBoolean(interp, src, (int *)(boolPtr)) : \ + ((sizeof(*(boolPtr)) <= sizeof(int)) ? Tcl_GetBool(interp, src, (TCL_NULL_OK-2)&(int)sizeof((*(boolPtr))), (char *)(boolPtr)) : \ + (TCLBOOLWARNING(boolPtr)Tcl_Panic("sizeof(%s) must be <= sizeof(int)", & #boolPtr [1]),TCL_ERROR))) #endif #ifdef TCL_MEM_DEBUG diff --git a/generic/tclDisassemble.c b/generic/tclDisassemble.c index 7a8783c..5a64ff8 100644 --- a/generic/tclDisassemble.c +++ b/generic/tclDisassemble.c @@ -45,21 +45,20 @@ static const Tcl_ObjType instNameType = { TCL_OBJTYPE_V0 }; -#define InstNameSetInternalRep(objPtr, inst) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (inst); \ +#define InstNameSetInternalRep(objPtr, inst) \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (inst); \ Tcl_StoreInternalRep((objPtr), &instNameType, &ir); \ } while (0) -#define InstNameGetInternalRep(objPtr, inst) \ - do { \ +#define InstNameGetInternalRep(objPtr, inst) \ + do { \ const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &instNameType); \ - assert(irPtr != NULL); \ - (inst) = irPtr->wideValue; \ + irPtr = TclFetchInternalRep((objPtr), &instNameType); \ + assert(irPtr != NULL); \ + (inst) = irPtr->wideValue; \ } while (0) - /* *---------------------------------------------------------------------- diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 4b1ef16..0844303 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -258,7 +258,6 @@ static Tcl_EncodingConvertProc UtfToUtfProc; static Tcl_EncodingConvertProc Iso88591FromUtfProc; static Tcl_EncodingConvertProc Iso88591ToUtfProc; - /* * A Tcl_ObjType for holding a cached Tcl_Encoding in the twoPtrValue.ptr1 field * of the internalrep. This should help the lifetime of encodings be more useful. @@ -274,21 +273,20 @@ static const Tcl_ObjType encodingType = { TCL_OBJTYPE_V0 }; -#define EncodingSetInternalRep(objPtr, encoding) \ +#define EncodingSetInternalRep(objPtr, encoding) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (encoding); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ + Tcl_StoreInternalRep((objPtr), &encodingType, &ir); \ } while (0) -#define EncodingGetInternalRep(objPtr, encoding) \ +#define EncodingGetInternalRep(objPtr, encoding) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep ((objPtr), &encodingType); \ - (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ + (encoding) = irPtr ? (Tcl_Encoding)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- @@ -1112,7 +1110,6 @@ Tcl_ExternalToUtfDString( NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } - /* *------------------------------------------------------------------------- @@ -1158,14 +1155,14 @@ Tcl_ExternalToUtfDStringEx( Tcl_Encoding encoding, /* The encoding for the source string, or NULL * for the default system encoding. */ const char *src, /* Source string in specified encoding. */ - Tcl_Size srcLen, /* Source string length in bytes, or < 0 for + Tcl_Size srcLen, /* Source string length in bytes, or < 0 for * encoding-specific string length. */ int flags, /* Conversion control flags. */ Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ Tcl_Size *errorLocPtr) /* Where to store the error location - (or TCL_INDEX_NONE if no error). May - be NULL. */ + * (or TCL_INDEX_NONE if no error). May + * be NULL. */ { char *dst; Tcl_EncodingState state; @@ -1430,7 +1427,6 @@ Tcl_UtfToExternalDString( NULL, encoding, src, srcLen, TCL_ENCODING_PROFILE_TCL8, dstPtr, NULL); return Tcl_DStringValue(dstPtr); } - /* *------------------------------------------------------------------------- @@ -1481,8 +1477,8 @@ Tcl_UtfToExternalDStringEx( Tcl_DString *dstPtr, /* Uninitialized or free DString in which the * converted string is stored. */ Tcl_Size *errorLocPtr) /* Where to store the error location - (or TCL_INDEX_NONE if no error). May - be NULL. */ + * (or TCL_INDEX_NONE if no error). May + * be NULL. */ { char *dst; Tcl_EncodingState state; diff --git a/generic/tclEnv.c b/generic/tclEnv.c index ef4e946..0128672 100644 --- a/generic/tclEnv.c +++ b/generic/tclEnv.c @@ -20,9 +20,9 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #if defined(_WIN32) # define tenviron _wenviron # define tenviron2utfdstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) + (char *)Tcl_Char16ToUtfDString((const unsigned short *)(str), -1, (dsPtr))) # define utf2tenvirondstr(str, dsPtr) (Tcl_DStringInit(dsPtr), \ - (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) + (const WCHAR *)Tcl_UtfToChar16DString((str), -1, (dsPtr))) # define techar WCHAR # ifdef USE_PUTENV # define putenv(env) _wputenv((const wchar_t *)env) @@ -30,13 +30,12 @@ TCL_DECLARE_MUTEX(envMutex) /* To serialize access to environ. */ #else # define tenviron environ # define tenviron2utfdstr(str, dsPtr) \ - Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) + Tcl_ExternalToUtfDString(NULL, str, -1, dsPtr) # define utf2tenvirondstr(str, dsPtr) \ - Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) + Tcl_UtfToExternalDString(NULL, str, -1, dsPtr) # define techar char #endif - /* MODULE_SCOPE */ size_t TclEnvEpoch = 0; /* Epoch of the tcl environment * (if changed with tcl-env). */ diff --git a/generic/tclEvent.c b/generic/tclEvent.c index 334cfae..60a8924 100644 --- a/generic/tclEvent.c +++ b/generic/tclEvent.c @@ -893,7 +893,6 @@ Tcl_SetExitProc( return prevExitProc; } - /* *---------------------------------------------------------------------- @@ -935,7 +934,6 @@ InvokeExitHandlers(void) firstExitPtr = NULL; Tcl_MutexUnlock(&exitMutex); } - /* *---------------------------------------------------------------------- @@ -1117,6 +1115,20 @@ static const struct { #ifdef STATIC_BUILD ".static" #endif +#ifndef TCL_WITH_EXTERNAL_TOMMATH + ".tommath-0103" +#endif +#ifdef TCL_WITH_INTERNAL_ZLIB + ".zlib-" +#if ZLIB_VER_MAJOR < 10 + "0" +#endif + STRINGIFY(ZLIB_VER_MAJOR) +#if ZLIB_VER_MINOR < 10 + "0" +#endif + STRINGIFY(ZLIB_VER_MINOR) +#endif }}; const char * diff --git a/generic/tclExecute.c b/generic/tclExecute.c index da08f3a..ef42940 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -192,7 +192,7 @@ VarHashCreateVar( /* Verify the stack depth, only when no expansion is in progress */ #ifdef TCL_COMPILE_DEBUG -#define CHECK_STACK() \ +#define CHECK_STACK() \ do { \ ValidatePcAndStackTop(codePtr, pc, CURR_DEPTH, \ /*checkStack*/ !(starting || auxObjList)); \ @@ -202,53 +202,53 @@ VarHashCreateVar( #define CHECK_STACK() #endif -#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ - do { \ - TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ - CHECK_STACK(); \ - if (nCleanup == 0) { \ - if (resultHandling != 0) { \ - if ((resultHandling) > 0) { \ - PUSH_OBJECT(objResultPtr); \ - } else { \ - *(++tosPtr) = objResultPtr; \ - } \ - } \ - pc += (pcAdjustment); \ - goto cleanup0; \ - } else if (resultHandling != 0) { \ - if ((resultHandling) > 0) { \ - Tcl_IncrRefCount(objResultPtr); \ - } \ - pc += (pcAdjustment); \ - switch (nCleanup) { \ - case 1: goto cleanup1_pushObjResultPtr; \ - case 2: goto cleanup2_pushObjResultPtr; \ - case 0: break; \ - } \ - } else { \ - pc += (pcAdjustment); \ - switch (nCleanup) { \ - case 1: goto cleanup1; \ - case 2: goto cleanup2; \ - case 0: break; \ - } \ - } \ +#define NEXT_INST_F(pcAdjustment, nCleanup, resultHandling) \ + do { \ + TCL_CT_ASSERT((nCleanup >= 0) && (nCleanup <= 2)); \ + CHECK_STACK(); \ + if (nCleanup == 0) { \ + if (resultHandling != 0) { \ + if ((resultHandling) > 0) { \ + PUSH_OBJECT(objResultPtr); \ + } else { \ + *(++tosPtr) = objResultPtr; \ + } \ + } \ + pc += (pcAdjustment); \ + goto cleanup0; \ + } else if (resultHandling != 0) { \ + if ((resultHandling) > 0) { \ + Tcl_IncrRefCount(objResultPtr); \ + } \ + pc += (pcAdjustment); \ + switch (nCleanup) { \ + case 1: goto cleanup1_pushObjResultPtr; \ + case 2: goto cleanup2_pushObjResultPtr; \ + case 0: break; \ + } \ + } else { \ + pc += (pcAdjustment); \ + switch (nCleanup) { \ + case 1: goto cleanup1; \ + case 2: goto cleanup2; \ + case 0: break; \ + } \ + } \ } while (0) -#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ - CHECK_STACK(); \ - do { \ - pc += (pcAdjustment); \ - cleanup = (nCleanup); \ - if (resultHandling) { \ - if ((resultHandling) > 0) { \ - Tcl_IncrRefCount(objResultPtr); \ - } \ - goto cleanupV_pushObjResultPtr; \ - } else { \ - goto cleanupV; \ - } \ +#define NEXT_INST_V(pcAdjustment, nCleanup, resultHandling) \ + CHECK_STACK(); \ + do { \ + pc += (pcAdjustment); \ + cleanup = (nCleanup); \ + if (resultHandling) { \ + if ((resultHandling) > 0) { \ + Tcl_IncrRefCount(objResultPtr); \ + } \ + goto cleanupV_pushObjResultPtr; \ + } else { \ + goto cleanupV; \ + } \ } while (0) #ifndef TCL_COMPILE_DEBUG @@ -258,16 +258,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_F(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_F(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_F(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_F(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ - break; \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -275,7 +275,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_F(0, (cleanup), 1); \ - break; \ + break; \ } \ } while (0) #define JUMP_PEEPHOLE_V(condition, pcAdjustment, cleanup) \ @@ -284,16 +284,16 @@ VarHashCreateVar( switch (*pc) { \ case INST_JUMP_FALSE1: \ NEXT_INST_V(((condition)? 2 : TclGetInt1AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE1: \ NEXT_INST_V(((condition)? TclGetInt1AtPtr(pc+1) : 2), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_FALSE4: \ NEXT_INST_V(((condition)? 5 : TclGetInt4AtPtr(pc+1)), (cleanup), 0); \ - break; \ + break; \ case INST_JUMP_TRUE4: \ NEXT_INST_V(((condition)? TclGetInt4AtPtr(pc+1) : 5), (cleanup), 0); \ - break; \ + break; \ default: \ if ((condition) < 0) { \ TclNewIntObj(objResultPtr, -1); \ @@ -301,7 +301,7 @@ VarHashCreateVar( objResultPtr = TCONST((condition) > 0); \ } \ NEXT_INST_V(0, (cleanup), 1); \ - break; \ + break; \ } \ } while (0) #else /* TCL_COMPILE_DEBUG */ @@ -377,13 +377,14 @@ VarHashCreateVar( #ifdef TCL_COMPILE_DEBUG # define TRACE(a) \ - while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ - printf a; \ - break; \ + while (traceInstructions) { \ + fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER \ + "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ + GetOpcodeName(pc)); \ + printf a; \ + break; \ } # define TRACE_APPEND(a) \ while (traceInstructions) { \ @@ -393,15 +394,16 @@ VarHashCreateVar( # define TRACE_ERROR(interp) \ TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); # define TRACE_WITH_OBJ(a, objPtr) \ - while (traceInstructions) { \ - fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ - CURR_DEPTH, \ - (pc - codePtr->codeStart), \ - GetOpcodeName(pc)); \ - printf a; \ - TclPrintObject(stdout, objPtr, 30); \ - fprintf(stdout, "\n"); \ - break; \ + while (traceInstructions) { \ + fprintf(stdout, "%2" TCL_SIZE_MODIFIER "d: %2" TCL_T_MODIFIER \ + "d (%" TCL_T_MODIFIER "d) %s ", iPtr->numLevels, \ + CURR_DEPTH, \ + (pc - codePtr->codeStart), \ + GetOpcodeName(pc)); \ + printf a; \ + TclPrintObject(stdout, objPtr, 30); \ + fprintf(stdout, "\n"); \ + break; \ } # define O2S(objPtr) \ (objPtr ? TclGetString(objPtr) : "") @@ -475,7 +477,8 @@ VarHashCreateVar( * usage in [incr]: do the first summand and the sum have != signs? */ -#define Overflowing(a,b,sum) ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) +#define Overflowing(a,b,sum) \ + ((((a)^(sum)) < 0) && (((a)^(b)) >= 0)) /* * Macro for checking whether the type is NaN, used when we're thinking about @@ -1024,7 +1027,6 @@ GrowEvaluationStack( } needed = growth + moveWords + WALLOCALIGN; - /* * Check if there is enough room in the next stack (if there is one, it * should be both empty and the last one!) @@ -1407,8 +1409,7 @@ CompileExprObj( Interp *iPtr = (Interp *) interp; CompileEnv compEnv; /* Compilation environment structure allocated * in frame. */ - ByteCode *codePtr = NULL; - /* Tcl Internal type of bytecode. Initialized + ByteCode *codePtr = NULL; /* Tcl Internal type of bytecode. Initialized * to avoid compiler warning. */ /* @@ -1563,7 +1564,7 @@ TclCompileObj( int word) { Interp *iPtr = (Interp *) interp; - ByteCode *codePtr; /* Tcl Internal type of bytecode. */ + ByteCode *codePtr; /* Tcl Internal type of bytecode. */ Namespace *namespacePtr = iPtr->varFramePtr->nsPtr; /* @@ -1847,7 +1848,7 @@ ArgumentBCEnter( ByteCode *codePtr, TEBCdata *tdPtr, const unsigned char *pc, - int objc, + Tcl_Size objc, Tcl_Obj **objv) { Tcl_Size cmd; @@ -2027,8 +2028,8 @@ TEBCresume( Tcl_Obj **tosPtr; /* Cached pointer to top of evaluation * stack. */ const unsigned char *pc = (const unsigned char *)data[1]; - /* The current program counter. */ - unsigned char inst; /* The currently running instruction */ + /* The current program counter. */ + unsigned char inst; /* The currently running instruction */ /* * Transfer variables - needed only between opcodes, but not while @@ -2037,7 +2038,7 @@ TEBCresume( int cleanup = PTR2INT(data[2]); Tcl_Obj *objResultPtr; - int checkInterp = 0; /* Indicates when a check of interp readyness + int checkInterp = 0; /* Indicates when a check of interp readyness * is necessary. Set by CACHE_STACK_INFO() */ /* @@ -2091,7 +2092,7 @@ TEBCresume( goto cleanup0; } else { - /* resume from invocation */ + /* resume from invocation */ CACHE_STACK_INFO(); NRE_ASSERT(iPtr->cmdFramePtr == bcFramePtr); @@ -2581,14 +2582,15 @@ TEBCresume( case INST_REVERSE: { Tcl_Obj **a, **b; - opnd = TclGetUInt4AtPtr(pc+1); - a = tosPtr-(opnd-1); + opnd = TclGetUInt4AtPtr(pc + 1); + a = tosPtr - (opnd - 1); b = tosPtr; - while (a<b) { + while (a < b) { tmpPtr = *a; *a = *b; *b = tmpPtr; - a++; b--; + a++; + b--; } TRACE(("%u => OK\n", opnd)); NEXT_INST_F(5, 0, 0); @@ -2619,7 +2621,7 @@ TEBCresume( */ opnd = TclGetUInt4AtPtr(pc+1); - objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd-1)); + objResultPtr = Tcl_ConcatObj(opnd, &OBJ_AT_DEPTH(opnd - 1)); TRACE_WITH_OBJ(("%u => ", opnd), objResultPtr); NEXT_INST_V(5, opnd, 1); break; @@ -3182,7 +3184,7 @@ TEBCresume( O2S(part1Ptr), O2S(part2Ptr), O2S(valuePtr))); } #endif - varPtr = TclObjLookupVarEx(interp, objPtr,part2Ptr, TCL_LEAVE_ERR_MSG, + varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "set", /*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr); if (!varPtr) { TRACE_ERROR(interp); @@ -3773,7 +3775,7 @@ TEBCresume( if (varPtr) { if (ReadTraced(varPtr) || (arrayPtr && ReadTraced(arrayPtr))) { DECACHE_STACK_INFO(); - TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr,part2Ptr, + TclObjCallVarTraces(iPtr, arrayPtr, varPtr, part1Ptr, part2Ptr, TCL_TRACE_READS, 0, -1); CACHE_STACK_INFO(); } @@ -4697,7 +4699,7 @@ TEBCresume( } /* - * End of TclOO support instructions. + * End of TclOO support instructions. * ----------------------------------------------------------------- * Start of INST_LIST and related instructions. */ @@ -4734,7 +4736,7 @@ TEBCresume( TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); /* special case for AbstractList */ - if (TclObjTypeHasProc(valuePtr,indexProc)) { + if (TclObjTypeHasProc(valuePtr, indexProc)) { DECACHE_STACK_INFO(); length = TclObjTypeLength(valuePtr); if (TclGetIntForIndexM(interp, value2Ptr, length-1, &index)!=TCL_OK) { @@ -4825,7 +4827,7 @@ TEBCresume( */ /* special case for AbstractList */ - if (TclObjTypeHasProc(valuePtr,indexProc)) { + if (TclObjTypeHasProc(valuePtr, indexProc)) { length = TclObjTypeLength(valuePtr); /* Decode end-offset index values. */ @@ -4924,11 +4926,11 @@ TEBCresume( DECACHE_STACK_INFO(); if (TclObjTypeHasProc(valuePtr, setElementProc)) { objResultPtr = TclObjTypeSetElement(interp, - valuePtr, numIndices, - &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); + valuePtr, numIndices, + &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } else { objResultPtr = TclLsetFlat(interp, valuePtr, numIndices, - &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); + &OBJ_AT_DEPTH(numIndices), OBJ_AT_TOS); } if (!objResultPtr) { CACHE_STACK_INFO(); @@ -5074,60 +5076,60 @@ TEBCresume( value2Ptr = OBJ_AT_TOS; valuePtr = OBJ_UNDER_TOS; - s1 = TclGetStringFromObj(valuePtr, &s1len); - TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); - - if (TclObjTypeHasProc(value2Ptr,inOperProc) != NULL) { - int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); - if (status != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - } else { - - if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { - TRACE_ERROR(interp); - goto gotError; - } - match = 0; - if (length > 0) { - Tcl_Size i = 0; - Tcl_Obj *o; - int isAbstractList = TclObjTypeHasProc(value2Ptr,indexProc) != NULL; - - /* - * An empty list doesn't match anything. - */ - - do { - if (isAbstractList) { - DECACHE_STACK_INFO(); - if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { - CACHE_STACK_INFO(); - TRACE_ERROR(interp); - goto gotError; - } - CACHE_STACK_INFO(); - } else { - Tcl_ListObjIndex(NULL, value2Ptr, i, &o); - } - if (o != NULL) { - s2 = TclGetStringFromObj(o, &s2len); - } else { - s2 = ""; - s2len = 0; - } - if (s1len == s2len) { - match = (memcmp(s1, s2, s1len) == 0); - } - - /* Could be an ephemeral abstract obj */ - Tcl_BounceRefCount(o); - - i++; - } while (i < length && match == 0); - } - } + s1 = TclGetStringFromObj(valuePtr, &s1len); + TRACE(("\"%.30s\" \"%.30s\" => ", O2S(valuePtr), O2S(value2Ptr))); + + if (TclObjTypeHasProc(value2Ptr, inOperProc) != NULL) { + int status = TclObjTypeInOperator(interp, valuePtr, value2Ptr, &match); + if (status != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + } else { + + if (TclListObjLength(interp, value2Ptr, &length) != TCL_OK) { + TRACE_ERROR(interp); + goto gotError; + } + match = 0; + if (length > 0) { + Tcl_Size i = 0; + Tcl_Obj *o; + int isAbstractList = TclObjTypeHasProc(value2Ptr, indexProc) != NULL; + + /* + * An empty list doesn't match anything. + */ + + do { + if (isAbstractList) { + DECACHE_STACK_INFO(); + if (TclObjTypeIndex(interp, value2Ptr, i, &o) != TCL_OK) { + CACHE_STACK_INFO(); + TRACE_ERROR(interp); + goto gotError; + } + CACHE_STACK_INFO(); + } else { + Tcl_ListObjIndex(NULL, value2Ptr, i, &o); + } + if (o != NULL) { + s2 = TclGetStringFromObj(o, &s2len); + } else { + s2 = ""; + s2len = 0; + } + if (s1len == s2len) { + match = (memcmp(s1, s2, s1len) == 0); + } + + /* Could be an ephemeral abstract obj */ + Tcl_BounceRefCount(o); + + i++; + } while (i < length && match == 0); + } + } if (*pc == INST_LIST_NOT_IN) { match = !match; @@ -5166,8 +5168,7 @@ TEBCresume( NEXT_INST_F(1, 1, 0); } - case INST_LREPLACE4: - { + case INST_LREPLACE4: { size_t numToDelete, numNewElems; int end_indicator; int haveSecondIndex, flags; @@ -5563,7 +5564,7 @@ TEBCresume( if ((*ustring1 == *ustring2) && /* Fix bug [69218ab7b]: restrict max compare length. */ ((end - ustring1) >= length2) && (length2 == 1 || - memcmp(ustring1, ustring2, + memcmp(ustring1, ustring2, sizeof(Tcl_UniChar) * length2) == 0)) { if (p != ustring1) { Tcl_AppendUnicodeToObj(objResultPtr, p, ustring1-p); @@ -6604,7 +6605,6 @@ TEBCresume( } CACHE_STACK_INFO(); - valIndex = (iterNum * numVars); for (j = 0; j < numVars; j++) { if (valIndex >= listLen) { @@ -7383,7 +7383,7 @@ TEBCresume( goto gotError; } DECACHE_STACK_INFO(); - result = TclDictWithFinish(interp, varPtr,arrayPtr,varNamePtr,NULL,-1, + result = TclDictWithFinish(interp, varPtr, arrayPtr, varNamePtr, NULL, -1, objc, objv, keysPtr); CACHE_STACK_INFO(); TclDecrRefCount(keysPtr); @@ -7426,38 +7426,38 @@ TEBCresume( * ----------------------------------------------------------------- */ - case INST_CLOCK_READ: - { /* Read the wall clock */ - Tcl_WideInt wval; - Tcl_Time now; - switch (TclGetUInt1AtPtr(pc+1)) { - case 0: /* clicks */ + case INST_CLOCK_READ: { /* Read the wall clock */ + Tcl_WideInt wval; + Tcl_Time now; + switch (TclGetUInt1AtPtr(pc+1)) { + case 0: /* clicks */ #ifdef TCL_WIDE_CLICKS - wval = TclpGetWideClicks(); + wval = TclpGetWideClicks(); #else - wval = (Tcl_WideInt)TclpGetClicks(); + wval = (Tcl_WideInt)TclpGetClicks(); #endif - break; - case 1: /* microseconds */ - Tcl_GetTime(&now); - wval = (Tcl_WideInt)now.sec * 1000000 + now.usec; - break; - case 2: /* milliseconds */ - Tcl_GetTime(&now); - wval = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000; - break; - case 3: /* seconds */ - Tcl_GetTime(&now); - wval = (Tcl_WideInt)now.sec; - break; - default: - Tcl_Panic("clockRead instruction with unknown clock#"); - } - TclNewIntObj(objResultPtr, wval); - TRACE_WITH_OBJ(("=> "), objResultPtr); - NEXT_INST_F(2, 0, 1); + break; + case 1: /* microseconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt)now.sec * 1000000 + now.usec; + break; + case 2: /* milliseconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt)now.sec * 1000 + now.usec / 1000; + break; + case 3: /* seconds */ + Tcl_GetTime(&now); + wval = (Tcl_WideInt)now.sec; + break; + default: + Tcl_Panic("clockRead instruction with unknown clock#"); + break; } - break; + TclNewIntObj(objResultPtr, wval); + TRACE_WITH_OBJ(("=> "), objResultPtr); + NEXT_INST_F(2, 0, 1); + } + break; default: Tcl_Panic("TclNRExecuteByteCode: unrecognized opCode %u", *pc); @@ -8656,17 +8656,17 @@ ExecuteExtendedBinaryMathOp( Tcl_TakeBignumFromObj(NULL, value2Ptr, &big2); err = mp_init(&bigResult); if (err == MP_OKAY) { - switch (opcode) { - case INST_ADD: + switch (opcode) { + case INST_ADD: err = mp_add(&big1, &big2, &bigResult); break; - case INST_SUB: + case INST_SUB: err = mp_sub(&big1, &big2, &bigResult); break; - case INST_MULT: + case INST_MULT: err = mp_mul(&big1, &big2, &bigResult); break; - case INST_DIV: + case INST_DIV: if (mp_iszero(&big2)) { mp_clear(&big1); mp_clear(&big2); @@ -8960,19 +8960,26 @@ TclCompareTwoNumbers( static void PrintByteCodeInfo( - ByteCode *codePtr) /* The bytecode whose summary is printed to + ByteCode *codePtr) /* The bytecode whose summary is printed to * stdout. */ { Proc *procPtr = codePtr->procPtr; Interp *iPtr = (Interp *) *codePtr->interpHandle; - fprintf(stdout, "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" TCL_Z_MODIFIER "u)\n", + fprintf(stdout, + "\nExecuting ByteCode 0x%p, refCt %" TCL_Z_MODIFIER + "u, epoch %" TCL_Z_MODIFIER "u, interp 0x%p (epoch %" + TCL_Z_MODIFIER "u)\n", codePtr, codePtr->refCount, codePtr->compileEpoch, iPtr, iPtr->compileEpoch); fprintf(stdout, " Source: "); TclPrintSource(stdout, codePtr->source, 60); - fprintf(stdout, "\n Cmds %" TCL_Z_MODIFIER "u, src %" TCL_Z_MODIFIER "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER "u, code/src %.2f\n", + fprintf(stdout, + "\n Cmds %" TCL_Z_MODIFIER "u, src %" TCL_Z_MODIFIER + "u, inst %" TCL_Z_MODIFIER "u, litObjs %" TCL_Z_MODIFIER + "u, aux %" TCL_Z_MODIFIER "u, stkDepth %" TCL_Z_MODIFIER + "u, code/src %.2f\n", codePtr->numCommands, codePtr->numSrcBytes, codePtr->numCodeBytes, codePtr->numLitObjects, codePtr->numAuxDataItems, codePtr->maxStackDepth, @@ -8983,8 +8990,11 @@ PrintByteCodeInfo( 0.0); #ifdef TCL_COMPILE_STATS - fprintf(stdout, " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER "u+inst %" TCL_Z_MODIFIER - "u+litObj %" TCL_Z_MODIFIER "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER "u+cmdMap %" TCL_Z_MODIFIER "u\n", + fprintf(stdout, + " Code %" TCL_Z_MODIFIER "u = header %" TCL_Z_MODIFIER + "u+inst %" TCL_Z_MODIFIER "u+litObj %" TCL_Z_MODIFIER + "u+exc %" TCL_Z_MODIFIER "u+aux %" TCL_Z_MODIFIER + "u+cmdMap %" TCL_Z_MODIFIER "u\n", codePtr->structureSize, offsetof(ByteCode, localCachePtr), codePtr->numCodeBytes, @@ -8995,7 +9005,8 @@ PrintByteCodeInfo( #endif /* TCL_COMPILE_STATS */ if (procPtr != NULL) { fprintf(stdout, - " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %" TCL_Z_MODIFIER "u, compiled locals %" TCL_Z_MODIFIER "u\n", + " Proc 0x%p, refCt %" TCL_Z_MODIFIER "u, args %" + TCL_Z_MODIFIER "u, compiled locals %" TCL_Z_MODIFIER "u\n", procPtr, procPtr->refCount, procPtr->numArgs, procPtr->numCompiledLocals); } @@ -9024,7 +9035,7 @@ PrintByteCodeInfo( #ifdef TCL_COMPILE_DEBUG static void ValidatePcAndStackTop( - ByteCode *codePtr, /* The bytecode whose summary is printed to + ByteCode *codePtr, /* The bytecode whose summary is printed to * stdout. */ const unsigned char *pc, /* Points to first byte of a bytecode * instruction. The program counter. */ @@ -9064,7 +9075,7 @@ ValidatePcAndStackTop( TclNewLiteralStringObj(message, "\n executing "); Tcl_IncrRefCount(message); Tcl_AppendLimitedToObj(message, cmd, numChars, 100, NULL); - fprintf(stderr,"%s\n", TclGetString(message)); + fprintf(stderr, "%s\n", TclGetString(message)); Tcl_DecrRefCount(message); } else { fprintf(stderr, "\n"); @@ -9096,7 +9107,7 @@ static void IllegalExprOperandType( Tcl_Interp *interp, /* Interpreter to which error information * pertains. */ - const unsigned char *pc, /* Points to the instruction being executed + const unsigned char *pc, /* Points to the instruction being executed * when the illegal type was found. */ Tcl_Obj *opndPtr) /* Points to the operand holding the value * with the illegal type. */ @@ -9156,25 +9167,25 @@ IllegalExprOperandType( Tcl_Obj * TclGetSourceFromFrame( CmdFrame *cfPtr, - int objc, + Tcl_Size objc, Tcl_Obj *const objv[]) { if (cfPtr == NULL) { - return Tcl_NewListObj(objc, objv); + return Tcl_NewListObj(objc, objv); } if (cfPtr->cmdObj == NULL) { - if (cfPtr->cmd == NULL) { - ByteCode *codePtr = (ByteCode *) cfPtr->data.tebc.codePtr; + if (cfPtr->cmd == NULL) { + ByteCode *codePtr = (ByteCode *)cfPtr->data.tebc.codePtr; - cfPtr->cmd = GetSrcInfoForPc((unsigned char *) + cfPtr->cmd = GetSrcInfoForPc((unsigned char *) cfPtr->data.tebc.pc, codePtr, &cfPtr->len, NULL, NULL); - } + } if (cfPtr->cmd) { cfPtr->cmdObj = Tcl_NewStringObj(cfPtr->cmd, cfPtr->len); } else { cfPtr->cmdObj = Tcl_NewListObj(objc, objv); } - Tcl_IncrRefCount(cfPtr->cmdObj); + Tcl_IncrRefCount(cfPtr->cmdObj); } return cfPtr->cmdObj; } @@ -9815,23 +9826,23 @@ EvalStatsCmd( currentHeaderBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Instructions %12.6g %8.1f%% %8.1f\n", statsPtr->currentInstBytes, - Percent(statsPtr->currentInstBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentInstBytes, statsPtr->currentByteCodeBytes), statsPtr->currentInstBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Literal ptr array %12.6g %8.1f%% %8.1f\n", statsPtr->currentLitBytes, - Percent(statsPtr->currentLitBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentLitBytes, statsPtr->currentByteCodeBytes), statsPtr->currentLitBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Exception table %12.6g %8.1f%% %8.1f\n", statsPtr->currentExceptBytes, - Percent(statsPtr->currentExceptBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentExceptBytes, statsPtr->currentByteCodeBytes), statsPtr->currentExceptBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Auxiliary data %12.6g %8.1f%% %8.1f\n", statsPtr->currentAuxBytes, - Percent(statsPtr->currentAuxBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentAuxBytes, statsPtr->currentByteCodeBytes), statsPtr->currentAuxBytes / numCurrentByteCodes); Tcl_AppendPrintfToObj(objPtr, "Command map %12.6g %8.1f%% %8.1f\n", statsPtr->currentCmdMapBytes, - Percent(statsPtr->currentCmdMapBytes,statsPtr->currentByteCodeBytes), + Percent(statsPtr->currentCmdMapBytes, statsPtr->currentByteCodeBytes), statsPtr->currentCmdMapBytes / numCurrentByteCodes); /* diff --git a/generic/tclHash.c b/generic/tclHash.c index 5be07cb..89807e2 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -214,7 +214,6 @@ FindHashEntry( { return CreateHashEntry(tablePtr, key, NULL); } - /* *---------------------------------------------------------------------- @@ -301,8 +300,7 @@ CreateHashEntry( } /* if needle pointer equals content pointer or values equal */ if ((key == hPtr->key.string) - || compareKeysProc((void *) key, hPtr) - ) { + || compareKeysProc((void *) key, hPtr)) { if (newPtr) { *newPtr = 0; } diff --git a/generic/tclIO.c b/generic/tclIO.c index 518adef..2d8b945 100644 --- a/generic/tclIO.c +++ b/generic/tclIO.c @@ -97,6 +97,7 @@ typedef struct GetsState { typedef struct CopyState { struct Channel *readPtr; /* Pointer to input channel. */ struct Channel *writePtr; /* Pointer to output channel. */ + int refCount; /* Reference counter. */ int readFlags; /* Original read channel flags. */ int writeFlags; /* Original write channel flags. */ Tcl_WideInt toRead; /* Number of bytes to copy, or -1. */ @@ -221,6 +222,7 @@ static int StackSetBlockMode(Channel *chanPtr, int mode); static int SetBlockMode(Tcl_Interp *interp, Channel *chanPtr, int mode); static void StopCopy(CopyState *csPtr); +static void CopyDecrRefCount(CopyState *csPtr); static void TranslateInputEOL(ChannelState *statePtr, char *dst, const char *src, int *dstLenPtr, int *srcLenPtr); static void UpdateInterest(Channel *chanPtr); @@ -2086,7 +2088,7 @@ Tcl_UnstackChannel( return TCL_ERROR; } - statePtr->csPtrR = csPtrR; + statePtr->csPtrR = csPtrR; statePtr->csPtrW = csPtrW; } @@ -3016,6 +3018,34 @@ FlushChannel( return errorCode; } +static void +FreeChannelState( + void *blockPtr) /* Channel state to free. */ +{ + ChannelState *statePtr = (ChannelState *)blockPtr; + /* + * Even after close some members can be filled again (in events etc). + * Test in bug [79474c588] illustrates one leak (on remaining chanMsg). + * Possible other fields need freeing on some constellations. + */ + + DiscardInputQueued(statePtr, 1); + if (statePtr->curOutPtr != NULL) { + ReleaseChannelBuffer(statePtr->curOutPtr); + } + DiscardOutputQueued(statePtr); + + DeleteTimerHandler(statePtr); + + if (statePtr->chanMsg) { + Tcl_DecrRefCount(statePtr->chanMsg); + } + if (statePtr->unreportedMsg) { + Tcl_DecrRefCount(statePtr->unreportedMsg); + } + Tcl_Free(statePtr); +} + /* *---------------------------------------------------------------------- * @@ -3180,7 +3210,7 @@ CloseChannel( ChannelFree(chanPtr); - Tcl_EventuallyFree(statePtr, TCL_DYNAMIC); + Tcl_EventuallyFree(statePtr, FreeChannelState); return errorCode; } @@ -3983,8 +4013,14 @@ Tcl_ClearChannelHandlers( * Cancel any pending copy operation. */ - StopCopy(statePtr->csPtrR); - StopCopy(statePtr->csPtrW); + if (statePtr->csPtrR) { + StopCopy(statePtr->csPtrR); + statePtr->csPtrR = NULL; + } + if (statePtr->csPtrW) { + StopCopy(statePtr->csPtrW); + statePtr->csPtrW = NULL; + } /* * Must set the interest mask now to 0, otherwise infinite loops will @@ -6243,7 +6279,7 @@ ReadChars( if (dstLimit <= 0) { dstLimit = INT_MAX; /* avoid overflow */ } - (void) TclGetStringFromObj(objPtr, &numBytes); + (void)TclGetStringFromObj(objPtr, &numBytes); TclAppendUtfToUtf(objPtr, NULL, dstLimit); if (toRead == srcLen) { Tcl_Size size; @@ -8756,8 +8792,7 @@ ChannelTimerProc( static void DeleteTimerHandler( - ChannelState *statePtr -) + ChannelState *statePtr) { if (statePtr->timer != NULL) { Tcl_DeleteTimerHandler(statePtr->timer); @@ -9344,6 +9379,7 @@ TclCopyChannel( csPtr->bufSize = !moveBytes * inStatePtr->bufSize; csPtr->readPtr = inPtr; csPtr->writePtr = outPtr; + csPtr->refCount = 2; /* two references below (inStatePtr, outStatePtr) */ csPtr->readFlags = readFlags; csPtr->writeFlags = writeFlags; csPtr->toRead = toRead; @@ -9354,7 +9390,10 @@ TclCopyChannel( } csPtr->cmdPtr = cmdPtr; - inStatePtr->csPtrR = csPtr; + TclChannelPreserve(inChan); + TclChannelPreserve(outChan); + + inStatePtr->csPtrR = csPtr; outStatePtr->csPtrW = csPtr; if (moveBytes) { @@ -9368,7 +9407,7 @@ TclCopyChannel( if ((nonBlocking == CHANNEL_NONBLOCKING) && (toRead == 0)) { Tcl_CreateTimerHandler(0, ZeroTransferTimerProc, csPtr); - return 0; + return TCL_OK; } /* @@ -9643,6 +9682,8 @@ CopyData( int moveBytes; int underflow; /* Input underflow */ + csPtr->refCount++; /* avoid freeing during handling */ + inChan = (Tcl_Channel) csPtr->readPtr; outChan = (Tcl_Channel) csPtr->writePtr; inStatePtr = csPtr->readPtr->state; @@ -9787,7 +9828,7 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - return TCL_OK; + goto done; } } @@ -9873,7 +9914,7 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - return TCL_OK; + goto done; } /* @@ -9895,7 +9936,7 @@ CopyData( TclDecrRefCount(bufObj); bufObj = NULL; } - return TCL_OK; + goto done; } } /* while */ @@ -9947,6 +9988,9 @@ CopyData( } } } + + done: + CopyDecrRefCount(csPtr); return result; } @@ -10056,8 +10100,6 @@ DoRead( code = GetInput(chanPtr); bufPtr = statePtr->inQueueHead; - assert(bufPtr != NULL); - if (GotFlag(statePtr, CHANNEL_EOF|CHANNEL_BLOCKED)) { /* * Further reads cannot do any more. @@ -10066,20 +10108,21 @@ DoRead( break; } - if (code) { - /* - * Read error - */ - - UpdateInterest(chanPtr); - TclChannelRelease((Tcl_Channel)chanPtr); - return -1; + if (code || !bufPtr) { + /* Read error (or channel dead/closed) */ + goto readErr; } assert(IsBufferFull(bufPtr)); } - assert(bufPtr != NULL); + if (!bufPtr) { + readErr: + + UpdateInterest(chanPtr); + TclChannelRelease((Tcl_Channel)chanPtr); + return -1; + } bytesRead = BytesLeft(bufPtr); bytesWritten = bytesToRead; @@ -10249,20 +10292,13 @@ Lossless( return inStatePtr->inEofChar == '\0' /* No eofChar to stop input */ && inStatePtr->inputTranslation == TCL_TRANSLATE_LF && outStatePtr->outputTranslation == TCL_TRANSLATE_LF - && ( - ( - inStatePtr->encoding == GetBinaryEncoding() - && - outStatePtr->encoding == GetBinaryEncoding() - ) - || - ( - toRead == -1 + && ((inStatePtr->encoding == GetBinaryEncoding() + && outStatePtr->encoding == GetBinaryEncoding()) + || (toRead == -1 && inStatePtr->encoding == outStatePtr->encoding && ENCODING_PROFILE_GET(inStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 && ENCODING_PROFILE_GET(outStatePtr->inputEncodingFlags) == TCL_ENCODING_PROFILE_TCL8 - ) - ); + )); } /* @@ -10328,9 +10364,32 @@ StopCopy( Tcl_DeleteChannelHandler(inChan, MBEvent, csPtr); Tcl_DeleteChannelHandler(outChan, MBEvent, csPtr); TclDecrRefCount(csPtr->cmdPtr); + csPtr->cmdPtr = NULL; + } + + if (inStatePtr->csPtrR) { + assert(inStatePtr->csPtrR == csPtr); + inStatePtr->csPtrR = NULL; + CopyDecrRefCount(csPtr); + } + if (outStatePtr->csPtrW) { + assert(outStatePtr->csPtrW == csPtr); + outStatePtr->csPtrW = NULL; + CopyDecrRefCount(csPtr); + } +} + +static void +CopyDecrRefCount( + CopyState *csPtr) +{ + if (csPtr->refCount-- > 1) { + return; } - inStatePtr->csPtrR = NULL; - outStatePtr->csPtrW = NULL; + + TclChannelRelease((Tcl_Channel)csPtr->readPtr); + TclChannelRelease((Tcl_Channel)csPtr->writePtr); + Tcl_Free(csPtr); } @@ -11080,7 +11139,7 @@ Tcl_SetChannelError( Tcl_Channel chan, /* Channel to store the data into. */ Tcl_Obj *msg) /* Error message to store. */ { - ChannelState *statePtr = ((Channel *) chan)->state; + ChannelState *statePtr = ((Channel *)chan)->state; Tcl_Obj *disposePtr = statePtr->chanMsg; if (msg != NULL) { diff --git a/generic/tclIO.h b/generic/tclIO.h index 08fff44..8823e06 100644 --- a/generic/tclIO.h +++ b/generic/tclIO.h @@ -191,8 +191,8 @@ typedef struct ChannelState { Tcl_Size bufSize; /* What size buffers to allocate? */ Tcl_TimerToken timer; /* Handle to wakeup timer for this channel. */ Channel *timerChanPtr; /* Needed in order to decrement the refCount of - the right channel when the timer is - deleted. */ + * the right channel when the timer is + * deleted. */ struct CopyState *csPtrR; /* State of background copy for which channel * is input, or NULL. */ struct CopyState *csPtrW; /* State of background copy for which channel diff --git a/generic/tclIOCmd.c b/generic/tclIOCmd.c index cb90059..fc4ddb6 100644 --- a/generic/tclIOCmd.c +++ b/generic/tclIOCmd.c @@ -606,7 +606,6 @@ Tcl_TellObjCmd( * them into the regular interpreter result. */ - code = TclChanCaughtErrorBypass(interp, chan); TclChannelRelease(chan); if (code) { diff --git a/generic/tclIORChan.c b/generic/tclIORChan.c index 5acd950..e8a243b 100644 --- a/generic/tclIORChan.c +++ b/generic/tclIORChan.c @@ -60,27 +60,27 @@ static int ReflectTruncate(void *clientData, */ static const Tcl_ChannelType tclRChannelType = { - "tclrchannel", /* Type name. */ + "tclrchannel", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close channel, clean instance data */ - ReflectInput, /* Handle read request */ - ReflectOutput, /* Handle write request */ + NULL, /* Old close API */ + ReflectInput, /* Handle read request */ + ReflectOutput, /* Handle write request */ NULL, - ReflectSetOption, /* Set options. NULL'able */ - ReflectGetOption, /* Get options. NULL'able */ - ReflectWatch, /* Initialize notifier */ - NULL, /* Get OS handle from the channel. NULL'able */ - ReflectClose, /* No close2 support. NULL'able */ - ReflectBlock, /* Set blocking/nonblocking. NULL'able */ - NULL, /* Flush channel. Not used by core. NULL'able */ - NULL, /* Handle events. NULL'able */ - ReflectSeekWide, /* Move access point (64 bit). NULL'able */ + ReflectSetOption, /* Set options. */ + ReflectGetOption, /* Get options. */ + ReflectWatch, /* Initialize notifier */ + NULL, /* Get OS handle from the channel. */ + ReflectClose, /* Close channel. Clean instance data */ + ReflectBlock, /* Set blocking/nonblocking. */ + NULL, /* Flush channel. */ + NULL, /* Handle events. */ + ReflectSeekWide, /* Move access point (64 bit). */ #if TCL_THREADS - ReflectThread, /* thread action, tracking owner */ + ReflectThread, /* thread action, tracking owner */ #else - NULL, /* thread action */ + NULL, /* thread action */ #endif - ReflectTruncate /* Truncate. NULL'able */ + ReflectTruncate /* Truncate. */ }; /* @@ -94,11 +94,10 @@ typedef struct { * Tcl level part of the channel. NULL here * signals the channel is dead because the * interpreter/thread containing its Tcl - * command is gone. - */ + * command is gone. */ #if TCL_THREADS Tcl_ThreadId thread; /* Thread the 'interp' belongs to. == Handler thread */ - Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ + Tcl_ThreadId owner; /* Thread owning the structure. == Channel thread */ #endif Tcl_Obj *cmd; /* Callback command prefix */ Tcl_Obj *methods; /* Methods to append to command prefix */ @@ -255,7 +254,7 @@ typedef struct { struct ForwardParamInput { ForwardParamBase base; /* "Supertype". MUST COME FIRST. */ char *buf; /* O: Where to store the read bytes */ - Tcl_Size toRead; /* I: #bytes to read, + Tcl_Size toRead; /* I: #bytes to read, * O: #bytes actually read */ }; struct ForwardParamOutput { @@ -502,7 +501,7 @@ TclChanCreateObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Channel chan; /* Token for the new channel */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ @@ -2262,23 +2261,37 @@ NextHandle(void) return resObj; } -static void -FreeReflectedChannel( - void *blockPtr) +static inline void +CleanRefChannelInstance( + ReflectedChannel *rcPtr) { - ReflectedChannel *rcPtr = (ReflectedChannel *) blockPtr; - Channel *chanPtr = (Channel *) rcPtr->chan; - - TclChannelRelease((Tcl_Channel)chanPtr); if (rcPtr->name) { + /* + * Reset obj-type (channel is deleted or dead anyway) to avoid leakage + * by cyclic references (see bug [79474c58800cdf94]). + */ + TclFreeInternalRep(rcPtr->name); Tcl_DecrRefCount(rcPtr->name); + rcPtr->name = NULL; } if (rcPtr->methods) { Tcl_DecrRefCount(rcPtr->methods); + rcPtr->methods = NULL; } if (rcPtr->cmd) { Tcl_DecrRefCount(rcPtr->cmd); + rcPtr->cmd = NULL; } +} +static void +FreeReflectedChannel( + void *blockPtr) +{ + ReflectedChannel *rcPtr = (ReflectedChannel *) blockPtr; + Channel *chanPtr = (Channel *) rcPtr->chan; + + TclChannelRelease((Tcl_Channel)chanPtr); + CleanRefChannelInstance(rcPtr); Tcl_Free(rcPtr); } @@ -2548,18 +2561,7 @@ MarkDead( if (rcPtr->dead) { return; } - if (rcPtr->name) { - Tcl_DecrRefCount(rcPtr->name); - rcPtr->name = NULL; - } - if (rcPtr->methods) { - Tcl_DecrRefCount(rcPtr->methods); - rcPtr->methods = NULL; - } - if (rcPtr->cmd) { - Tcl_DecrRefCount(rcPtr->cmd); - rcPtr->cmd = NULL; - } + CleanRefChannelInstance(rcPtr); rcPtr->dead = 1; } diff --git a/generic/tclIORTrans.c b/generic/tclIORTrans.c index c1e5c31..2ad6ecf0 100644 --- a/generic/tclIORTrans.c +++ b/generic/tclIORTrans.c @@ -58,18 +58,17 @@ static int ReflectNotify(void *clientData, int mask); static const Tcl_ChannelType tclRTransformType = { "tclrtransform", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel. */ - NULL, /* Close channel, clean instance data. */ + NULL, ReflectInput, /* Handle read request. */ ReflectOutput, /* Handle write request. */ - NULL, /* Move location of access point. */ + NULL, /* Move location of access point. */ ReflectSetOption, /* Set options. */ ReflectGetOption, /* Get options. */ ReflectWatch, /* Initialize notifier. */ ReflectHandle, /* Get OS handle from the channel. */ - ReflectClose, /* No close2 support. NULL'able. */ + ReflectClose, /* Close channel, clean instance data. */ ReflectBlock, /* Set blocking/nonblocking. */ - NULL, /* Flush channel. Not used by core. - * NULL'able. */ + NULL, /* Flush channel. Not used by core. */ ReflectNotify, /* Handle events. */ ReflectSeekWide, /* Move access point (64 bit). */ NULL, /* thread action */ @@ -511,7 +510,7 @@ TclChanPushObjCmd( Tcl_Obj *cmdNameObj; /* Command name */ Tcl_Obj *rtId; /* Handle of the new transform (channel) */ Tcl_Obj *modeObj; /* mode in obj form for method call */ - Tcl_Size listc; /* Result of 'initialize', and of */ + Tcl_Size listc; /* Result of 'initialize', and of */ Tcl_Obj **listv; /* its sublist in the 2nd element */ int methIndex; /* Encoded method name */ int result; /* Result code for 'initialize' */ @@ -1105,7 +1104,6 @@ ReflectInput( goto stop; } - /* * The buffer is exhausted, but the caller wants even more. We now * have to go to the underlying channel, get more bytes and then @@ -1141,7 +1139,6 @@ ReflectInput( goto stop; } - readBytes = Tcl_ReadRaw(rtPtr->parent, (char *) Tcl_SetByteArrayLength(bufObj, toRead), toRead); if (readBytes < 0) { @@ -1492,7 +1489,7 @@ ReflectBlock( static int ReflectSetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ const char *newValue) /* The new value */ @@ -1534,7 +1531,7 @@ ReflectSetOption( static int ReflectGetOption( - void *clientData, /* Channel to query */ + void *clientData, /* Channel to query */ Tcl_Interp *interp, /* Interpreter to leave error messages in */ const char *optionName, /* Name of requested option */ Tcl_DString *dsPtr) /* String to place the result into */ @@ -1645,7 +1642,6 @@ ReflectNotify( /* * Helpers. ========================================================= */ - /* *---------------------------------------------------------------------- @@ -2075,7 +2071,8 @@ static ReflectedTransformMap * GetReflectedTransformMap( Tcl_Interp *interp) { - ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *)Tcl_GetAssocData(interp, RTMKEY, NULL); + ReflectedTransformMap *rtmPtr = (ReflectedTransformMap *) + Tcl_GetAssocData(interp, RTMKEY, NULL); if (rtmPtr == NULL) { rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); @@ -2108,7 +2105,7 @@ GetReflectedTransformMap( static void DeleteReflectedTransformMap( - void *clientData, /* The per-interpreter data structure. */ + void *clientData, /* The per-interpreter data structure. */ Tcl_Interp *interp) /* The interpreter being deleted. */ { ReflectedTransformMap *rtmPtr; /* The map */ @@ -2243,7 +2240,8 @@ GetThreadReflectedTransformMap(void) ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (!tsdPtr->rtmPtr) { - tsdPtr->rtmPtr = (ReflectedTransformMap *)Tcl_Alloc(sizeof(ReflectedTransformMap)); + tsdPtr->rtmPtr = (ReflectedTransformMap *) + Tcl_Alloc(sizeof(ReflectedTransformMap)); Tcl_InitHashTable(&tsdPtr->rtmPtr->map, TCL_STRING_KEYS); Tcl_CreateThreadExitHandler(DeleteThreadReflectedTransformMap, NULL); } @@ -2993,7 +2991,7 @@ static inline size_t ResultCopy( ResultBuffer *rPtr, /* The buffer to read from */ unsigned char *buf, /* The buffer to copy into */ - size_t toRead) /* Number of requested bytes */ + size_t toRead) /* Number of requested bytes */ { int copied; diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c index 47fde36..81526fa 100644 --- a/generic/tclIOSock.c +++ b/generic/tclIOSock.c @@ -18,7 +18,7 @@ typedef struct { int initialized; - Tcl_DString errorMsg; /* UTF-8 encoded error-message */ + Tcl_DString errorMsg; /* UTF-8 encoded error-message */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -75,7 +75,8 @@ TclSockGetPort( * Don't bother translating 'proto' to native. */ - if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, string, -1, 0, &ds, + NULL) != TCL_OK) { Tcl_DStringFree(&ds); return TCL_ERROR; } @@ -188,7 +189,8 @@ TclCreateSocketAddress( int result; if (host != NULL) { - if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, NULL) != TCL_OK) { + if (Tcl_UtfToExternalDStringEx(interp, NULL, host, -1, 0, &ds, + NULL) != TCL_OK) { Tcl_DStringFree(&ds); return 0; } diff --git a/generic/tclIOUtil.c b/generic/tclIOUtil.c index 6067282..c3131cd 100644 --- a/generic/tclIOUtil.c +++ b/generic/tclIOUtil.c @@ -35,7 +35,7 @@ */ typedef struct FilesystemRecord { - void *clientData; /* Client-specific data for the filesystem + void *clientData; /* Client-specific data for the filesystem * (can be NULL) */ const Tcl_Filesystem *fsPtr;/* Pointer to filesystem dispatch table. */ struct FilesystemRecord *nextPtr; @@ -52,13 +52,11 @@ typedef struct FilesystemRecord { typedef struct { int initialized; size_t cwdPathEpoch; /* Compared with the global cwdPathEpoch to - * determine whether cwdPathPtr is stale. - */ + * determine whether cwdPathPtr is stale. */ size_t filesystemEpoch; Tcl_Obj *cwdPathPtr; /* A private copy of cwdPathPtr. Updated when * the value is accessed and cwdPathEpoch has - * changed. - */ + * changed. */ void *cwdClientData; FilesystemRecord *filesystemList; size_t claims; @@ -106,7 +104,6 @@ static Tcl_FSFileAttrsSetProc NativeFileAttrsSet; MODULE_SCOPE const char *const tclpFileAttrStrings[]; MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; - /* * These these functions are not static either because routines in the native * (win/unix) directories call them or they are actually implemented in those @@ -242,7 +239,8 @@ typedef struct { /* Obsolete */ int Tcl_Stat( - const char *path, /* Pathname of file to stat (in current CP). */ + const char *path, /* Pathname of file to stat (in current system + * encoding). */ struct stat *oldStyleBuf) /* Filled with results of stat call. */ { int ret; @@ -329,8 +327,8 @@ Tcl_Stat( /* Obsolete */ int Tcl_Access( - const char *path, /* Pathname of file to access (in current CP). - */ + const char *path, /* Pathname of file to access (in current + * system encoding). */ int mode) /* Permission setting. */ { int ret; @@ -845,7 +843,7 @@ TclResetFilesystem(void) int Tcl_FSRegister( - void *clientData, /* Client-specific data for this filesystem. */ + void *clientData, /* Client-specific data for this filesystem. */ const Tcl_Filesystem *fsPtr)/* The filesystem record for the new fs. */ { FilesystemRecord *newFilesystemPtr; @@ -1105,8 +1103,7 @@ FsAddMountsToGlobResult( Tcl_Obj *pathPtr, /* The directory that was searched. */ const char *pattern, /* Pattern to match mounts against. */ Tcl_GlobTypeData *types) /* Acceptable types. May be NULL. The - * directory flag is particularly significant. - */ + * directory flag is particularly significant. */ { Tcl_Size mLength, gLength, i; int dir = (types == NULL || (types->type & TCL_GLOB_TYPE_DIR)); @@ -1171,7 +1168,6 @@ FsAddMountsToGlobResult( } len++; /* account for '/' in the mElt [Bug 1602539] */ - mElt = TclNewFSPathObj(pathPtr, mount + len, mlen - len); Tcl_ListObjAppendElement(NULL, resultPtr, mElt); } @@ -1365,7 +1361,6 @@ TclFSNormalizeToUniquePath( Claim(); if (!isVfsPath) { - /* * Find and call the native filesystem handler first if there is one * because the root of Tcl's filesystem is always a native filesystem @@ -1693,7 +1688,7 @@ Tcl_FSEvalFileEx( * Tilde-substitution is performed on this * pathname. */ const char *encodingName) /* Either the name of an encoding or NULL to - use the utf-8 encoding. */ + * use the utf-8 encoding. */ { Tcl_Size length; int result = TCL_ERROR; @@ -2086,7 +2081,7 @@ Tcl_PosixError( int Tcl_FSStat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - * current CP). */ + * current system encoding). */ Tcl_StatBuf *buf) /* A buffer to hold the results of the call to * stat. */ { @@ -2121,7 +2116,7 @@ Tcl_FSStat( int Tcl_FSLstat( Tcl_Obj *pathPtr, /* Pathname of the file to call stat on (in - current CP). */ + * current system encoding). */ Tcl_StatBuf *buf) /* Filled with results of that call to stat. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -2158,7 +2153,8 @@ Tcl_FSLstat( int Tcl_FSAccess( - Tcl_Obj *pathPtr, /* Pathname of file to access (in current CP). */ + Tcl_Obj *pathPtr, /* Pathname of file to access (in current + * system encoding). */ int mode) /* Permission setting. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -2195,12 +2191,11 @@ Tcl_FSOpenFileChannel( const char *modeString, /* A list of POSIX open modes or a string such * as "rw". */ int permissions) /* What modes to use if opening the file - involves creating it. */ + * involves creating it. */ { const Tcl_Filesystem *fsPtr; Tcl_Channel retVal = NULL; - if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) { /* * Return the correct error message. @@ -3020,8 +3015,8 @@ Tcl_FSChdir( int Tcl_FSLoadFile( Tcl_Interp *interp, /* Used for error reporting. */ - Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic shared object. - */ + Tcl_Obj *pathPtr, /* Pathname of the file containing the dynamic + * shared object. */ const char *sym1, const char *sym2, /* Names of two functions to find in the * dynamic shared object. */ @@ -3109,14 +3104,13 @@ skipUnlink( * * 1. The operating system is HPUX. * - * 2. If the environment variable TCL_TEMPLOAD_NO_UNLINK is present and - * set to true (an integer > 0) - * - * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS filesystem can be detected (using statfs, if available). + * 2. If the environment variable TCL_TEMPLOAD_NO_UNLINK is present and + * set to true (an integer > 0) * + * 3. TCL_TEMPLOAD_NO_UNLINK is not true (an integer > 0) and AUFS + * filesystem can be detected (using statfs, if available). */ - #ifdef hpux (void)shlibFile; return 1; @@ -3655,9 +3649,7 @@ Tcl_FSUnloadFile( Tcl_Obj * Tcl_FSLink( Tcl_Obj *pathPtr, /* Pathaname of file. */ - Tcl_Obj *toPtr, /* - * NULL or the pathname of a file to link to. - */ + Tcl_Obj *toPtr, /* NULL or the pathname of a file to link to. */ int linkAction) /* Action to perform. */ { const Tcl_Filesystem *fsPtr = Tcl_FSGetFileSystemForPath(pathPtr); @@ -3906,7 +3898,8 @@ TclGetPathType( /* If not NULL, a place in which to store a * pointer to the filesystem for this pathname * if it is absolute. */ - Tcl_Size *driveNameLengthPtr, /* If not NULL, a place in which to store the + Tcl_Size *driveNameLengthPtr, + /* If not NULL, a place in which to store the * length of the volume name. */ Tcl_Obj **driveNameRef) /* If not NULL, for an absolute pathname, a * place to store a pointer to an object with a @@ -3960,9 +3953,9 @@ TclFSNonnativePathType( /* If not NULL, a place to store a pointer to * the filesystem for this pathname when it is * an absolute pathname. */ - Tcl_Size *driveNameLengthPtr,/* If not NULL, a place to store the length of - * the volume name if the pathname is absolute. - */ + Tcl_Size *driveNameLengthPtr, + /* If not NULL, a place to store the length of + * the volume name if the pathname is absolute. */ Tcl_Obj **driveNameRef) /* If not NULL, a place to store a pointer to * an object having its its refCount already * incremented, and contining the name of the @@ -4078,7 +4071,7 @@ TclFSNonnativePathType( int Tcl_FSRenameFile( Tcl_Obj *srcPathPtr, /* The pathname of a file or directory to be - renamed. */ + * renamed. */ Tcl_Obj *destPathPtr) /* The new pathname for the file. */ { int retVal = -1; diff --git a/generic/tclInt.h b/generic/tclInt.h index 7d2e848..ed8336b 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -257,7 +257,7 @@ typedef struct Namespace { * synonym. */ char *fullName; /* The namespace's fully qualified name. This * starts with ::. */ - void *clientData; /* An arbitrary value associated with this + void *clientData; /* An arbitrary value associated with this * namespace. */ Tcl_NamespaceDeleteProc *deleteProc; /* Procedure invoked when deleting the @@ -279,7 +279,7 @@ typedef struct Namespace { #else unsigned long nsId; #endif - Tcl_Interp *interp; /* The interpreter containing this + Tcl_Interp *interp; /* The interpreter containing this * namespace. */ int flags; /* OR-ed combination of the namespace status * flags NS_DYING and NS_DEAD listed below. */ @@ -312,12 +312,12 @@ typedef struct Namespace { * registered using "namespace export". */ Tcl_Size maxExportPatterns; /* Number of export patterns for which space * is currently allocated. */ - Tcl_Size cmdRefEpoch; /* Incremented if a newly added command + Tcl_Size cmdRefEpoch; /* Incremented if a newly added command * shadows a command for which this namespace * has already cached a Command* pointer; this * causes all its cached Command* pointers to * be invalidated. */ - Tcl_Size resolverEpoch; /* Incremented whenever (a) the name + Tcl_Size resolverEpoch; /* Incremented whenever (a) the name * resolution rules change for this namespace * or (b) a newly added command shadows a * command that is compiled to bytecodes. This @@ -424,8 +424,8 @@ struct NamespacePathEntry { * TCL_NAMESPACE_ONLY - (see tcl.h) Look only in the context ns. * TCL_CREATE_NS_IF_UNKNOWN - Create unknown namespaces. * TCL_FIND_ONLY_NS - The name sought is a namespace name. - * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of - * name is not simple name (contains ::). + * TCL_FIND_IF_NOT_SIMPLE - Retrieve last namespace even if the rest of + * name is not simple name (contains ::). */ #define TCL_CREATE_NS_IF_UNKNOWN 0x800 @@ -447,7 +447,7 @@ typedef struct EnsembleConfig { * if the command has been deleted (or never * existed; the global namespace never has an * ensemble command.) */ - Tcl_Size epoch; /* The epoch at which this ensemble's table of + Tcl_Size epoch; /* The epoch at which this ensemble's table of * exported commands is valid. */ char **subcommandArrayPtr; /* Array of ensemble subcommand names. At all * consistent points, this will have the same @@ -504,7 +504,7 @@ typedef struct EnsembleConfig { * core, presumably because the ensemble * itself has been updated. */ Tcl_Obj *parameterList; /* List of ensemble parameter names. */ - Tcl_Size numParameters; /* Cached number of parameters. This is either + Tcl_Size numParameters; /* Cached number of parameters. This is either * 0 (if the parameterList field is NULL) or * the length of the list in the parameterList * field. */ @@ -534,7 +534,7 @@ typedef struct EnsembleConfig { typedef struct VarTrace { Tcl_VarTraceProc *traceProc;/* Procedure to call when operations given by * flags are performed on variable. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_READS, TCL_TRACE_WRITES, @@ -553,7 +553,7 @@ typedef struct CommandTrace { Tcl_CommandTraceProc *traceProc; /* Procedure to call when operations given by * flags are performed on command. */ - void *clientData; /* Argument to pass to proc. */ + void *clientData; /* Argument to pass to proc. */ int flags; /* What events the trace procedure is * interested in: OR-ed combination of * TCL_TRACE_RENAME, TCL_TRACE_DELETE. */ @@ -834,10 +834,10 @@ typedef struct VarInHash { #define TclVarFindHiddenArray(varPtr,arrayPtr) \ do { \ - if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ - (TclVarParentArray(varPtr) != NULL)) { \ - arrayPtr = TclVarParentArray(varPtr); \ - } \ + if ((arrayPtr == NULL) && TclIsVarInHash(varPtr) && \ + (TclVarParentArray(varPtr) != NULL)) { \ + arrayPtr = TclVarParentArray(varPtr); \ + } \ } while(0) #define TclIsVarScalar(varPtr) \ @@ -903,13 +903,13 @@ typedef struct VarInHash { #define TclIsVarTricky(varPtr,trickyFlags) \ ( ((varPtr)->flags & (VAR_ARRAY|VAR_LINK|trickyFlags)) \ - || (TclIsVarInHash(varPtr) \ - && (TclVarParentArray(varPtr) != NULL) \ - && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) + || (TclIsVarInHash(varPtr) \ + && (TclVarParentArray(varPtr) != NULL) \ + && (TclVarParentArray(varPtr)->flags & (trickyFlags)))) #define TclIsVarDirectReadable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectWritable(varPtr) \ (!TclIsVarTricky(varPtr,VAR_TRACED_WRITE|VAR_DEAD_HASH|VAR_CONSTANT)) @@ -919,7 +919,7 @@ typedef struct VarInHash { #define TclIsVarDirectModifyable(varPtr) \ ( (!TclIsVarTricky(varPtr,VAR_TRACED_READ|VAR_TRACED_WRITE|VAR_CONSTANT)) \ - && (varPtr)->value.objPtr) + && (varPtr)->value.objPtr) #define TclIsVarDirectReadable2(varPtr, arrayPtr) \ (TclIsVarDirectReadable(varPtr) &&\ @@ -973,9 +973,9 @@ typedef struct CompiledLocal { /* Next compiler-recognized local variable for * this procedure, or NULL if this is the last * local. */ - Tcl_Size nameLength; /* The number of bytes in local variable's name. + Tcl_Size nameLength; /* The number of bytes in local variable's name. * Among others used to speed up var lookups. */ - Tcl_Size frameIndex; /* Index in the array of compiler-assigned + Tcl_Size frameIndex; /* Index in the array of compiler-assigned * variables in the procedure call frame. */ #if TCL_MAJOR_VERSION < 9 int flags; @@ -996,7 +996,7 @@ typedef struct CompiledLocal { * although only VAR_ARGUMENT, VAR_TEMPORARY, * and VAR_RESOLVED make sense. */ #endif - char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If + char name[TCLFLEXARRAY]; /* Name of the local variable starts here. If * the name is NULL, this will just be '\0'. * The actual size of this field will be large * enough to hold the name. MUST BE THE LAST @@ -1058,7 +1058,7 @@ typedef struct Trace { #else Tcl_CmdObjTraceProc *proc; /* Procedure to call to trace command. */ #endif - void *clientData; /* Arbitrary value to pass to proc. */ + void *clientData; /* Arbitrary value to pass to proc. */ struct Trace *nextPtr; /* Next in list of traces for this interp. */ int flags; /* Flags governing the trace - see * Tcl_CreateObjTrace for details. */ @@ -1108,18 +1108,17 @@ typedef struct ActiveInterpTrace { ((objPtr)->typePtr)->proc : NULL) MODULE_SCOPE Tcl_Size TclLengthOne(Tcl_Obj *); - /* * Abstract List * - * This structure provides the functions used in List operations to emulate a - * List for AbstractList types. + * This structure provides the functions used in List operations to emulate a + * List for AbstractList types. */ - static inline Tcl_Size -TclObjTypeLength(Tcl_Obj *objPtr) +TclObjTypeLength( + Tcl_Obj *objPtr) { Tcl_ObjTypeLengthProc *proc = TclObjTypeHasProc(objPtr, lengthProc); return proc(objPtr); @@ -1188,15 +1187,17 @@ TclObjTypeReplace( return proc(interp, objPtr, first, numToDelete, numToInsert, insertObjs); } static inline int -TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj, - struct Tcl_Obj *listObj, int *boolResult) +TclObjTypeInOperator( + Tcl_Interp *interp, + Tcl_Obj *valueObj, + Tcl_Obj *listObj, + int *boolResult) { Tcl_ObjTypeInOperatorProc *proc = TclObjTypeHasProc(listObj, inOperProc); return proc(interp, valueObj, listObj, boolResult); } #endif /* TCL_MAJOR_VERSION > 8 */ - /* * The structure below defines an entry in the assocData hash table which is * associated with an interpreter. The entry contains a pointer to a function @@ -1206,7 +1207,7 @@ TclObjTypeInOperator(Tcl_Interp *interp, struct Tcl_Obj *valueObj, typedef struct AssocData { Tcl_InterpDeleteProc *proc; /* Proc to call when deleting. */ - void *clientData; /* Value to pass to proc. */ + void *clientData; /* Value to pass to proc. */ } AssocData; /* @@ -1250,11 +1251,10 @@ typedef struct CallFrame { * If FRAME_IS_PROC is set, the frame was * pushed to execute a Tcl procedure and may * have local vars. */ - Tcl_Size objc; /* This and objv below describe the arguments + Tcl_Size objc; /* This and objv below describe the arguments * for this procedure call. */ Tcl_Obj *const *objv; /* Array of argument objects. */ - struct CallFrame *callerPtr; - /* Value of interp->framePtr when this + struct CallFrame *callerPtr;/* Value of interp->framePtr when this * procedure was invoked (i.e. next higher in * stack of all active procedures). */ struct CallFrame *callerVarPtr; @@ -1264,7 +1264,7 @@ typedef struct CallFrame { * callerPtr unless an "uplevel" command or * something equivalent was active in the * caller). */ - Tcl_Size level; /* Level of this procedure, for "uplevel" + Tcl_Size level; /* Level of this procedure, for "uplevel" * purposes (i.e. corresponds to nesting of * callerVarPtr's, not callerPtr's). 1 for * outermost procedure, 0 for top-level. */ @@ -1284,7 +1284,7 @@ typedef struct CallFrame { * recognized by the compiler. The compiler * emits code that refers to these variables * using an index into this array. */ - void *clientData; /* Pointer to some context that is used by + void *clientData; /* Pointer to some context that is used by * object systems. The meaning of the contents * of this field is defined by the code that * sets it, and it should only ever be set by @@ -1294,8 +1294,7 @@ typedef struct CallFrame { * meaning of the value is, which we do not * specify. */ LocalCache *localCachePtr; - Tcl_Obj *tailcallPtr; - /* NULL if no tailcall is scheduled */ + Tcl_Obj *tailcallPtr; /* NULL if no tailcall is scheduled */ } CallFrame; #define FRAME_IS_PROC 0x1 @@ -1384,7 +1383,7 @@ typedef struct CmdFrame { } data; Tcl_Obj *cmdObj; const char *cmd; /* The executed command, if possible... */ - Tcl_Size len; /* ... and its length. */ + Tcl_Size len; /* ... and its length. */ const struct CFWordBC *litarg; /* Link to set of literal arguments which have * ben pushed on the lineLABCPtr stack by @@ -1394,16 +1393,16 @@ typedef struct CmdFrame { typedef struct CFWord { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size word; /* Index of the word in the command. */ + Tcl_Size word; /* Index of the word in the command. */ Tcl_Size refCount; /* Number of times the word is on the * stack. */ } CFWord; typedef struct CFWordBC { CmdFrame *framePtr; /* CmdFrame to access. */ - Tcl_Size pc; /* Instruction pointer of a command in + Tcl_Size pc; /* Instruction pointer of a command in * ExtCmdLoc.loc[.] */ - Tcl_Size word; /* Index of word in + Tcl_Size word; /* Index of word in * ExtCmdLoc.loc[cmd]->line[.] */ struct CFWordBC *prevPtr; /* Previous entry in stack for same Tcl_Obj. */ struct CFWordBC *nextPtr; /* Next entry for same command call. See @@ -1432,7 +1431,7 @@ typedef struct CFWordBC { #define CLL_END (-1) typedef struct ContLineLoc { - Tcl_Size num; /* Number of entries in loc, not counting the + Tcl_Size num; /* Number of entries in loc, not counting the * final -1 marker entry. */ Tcl_Size loc[TCLFLEXARRAY];/* Table of locations, as character offsets. * The table is allocated as part of the @@ -1475,14 +1474,14 @@ typedef struct ContLineLoc { typedef Tcl_Obj * (GetFrameInfoValueProc)(void *clientData); typedef struct { const char *name; /* Name of this field. */ - GetFrameInfoValueProc *proc; /* Function to generate a Tcl_Obj* from the + GetFrameInfoValueProc *proc;/* Function to generate a Tcl_Obj* from the * clientData, or just use the clientData * directly (after casting) if NULL. */ - void *clientData; /* Context for above function, or Tcl_Obj* if + void *clientData; /* Context for above function, or Tcl_Obj* if * proc field is NULL. */ } ExtraFrameInfoField; typedef struct { - Tcl_Size length; /* Length of array. */ + Tcl_Size length; /* Length of array. */ ExtraFrameInfoField fields[2]; /* Really as long as necessary, but this is * long enough for nearly anything. */ @@ -1605,22 +1604,22 @@ typedef struct CoroutineData { * the coroutine, which might be the * interpreter global environment or another * coroutine. */ - CorContext caller; - CorContext running; - Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ + CorContext caller; /* Caller's saved execution context. */ + CorContext running; /* This coroutine's saved execution context. */ + Tcl_HashTable *lineLABCPtr; /* See Interp.lineLABCPtr */ void *stackLevel; - Tcl_Size auxNumLevels; /* While the coroutine is running the + Tcl_Size auxNumLevels; /* While the coroutine is running the * numLevels of the create/resume command is * stored here; for suspended coroutines it * holds the nesting numLevels at yield. */ - Tcl_Size nargs; /* Number of args required for resuming this - * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL means "0 or 1" - * (default), COROUTINE_ARGUMENTS_ARBITRARY means "any" */ + Tcl_Size nargs; /* Number of args required for resuming this + * coroutine; COROUTINE_ARGUMENTS_SINGLE_OPTIONAL + * means "0 or 1" (default), + * COROUTINE_ARGUMENTS_ARBITRARY means "any" */ Tcl_Obj *yieldPtr; /* The command to yield to. Stored here in * order to reset splice point in * TclNRCoroutineActivateCallback if the - * coroutine is busy. - */ + * coroutine is busy. */ } CoroutineData; typedef struct ExecEnv { @@ -1677,11 +1676,11 @@ typedef struct LiteralTable { LiteralEntry *staticBuckets[TCL_SMALL_HASH_TABLE]; /* Bucket array used for small tables to avoid * mallocs and frees. */ - TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at + TCL_HASH_TYPE numBuckets; /* Total number of buckets allocated at * **buckets. */ - TCL_HASH_TYPE numEntries; /* Total number of entries present in + TCL_HASH_TYPE numEntries; /* Total number of entries present in * table. */ - TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be + TCL_HASH_TYPE rebuildSize; /* Enlarge table when numEntries gets to be * this large. */ TCL_HASH_TYPE mask; /* Mask value used in hashing function. */ } LiteralTable; @@ -1694,10 +1693,11 @@ typedef struct LiteralTable { #ifdef TCL_COMPILE_STATS typedef struct ByteCodeStats { - size_t numExecutions; /* Number of ByteCodes executed. */ + size_t numExecutions; /* Number of ByteCodes executed. */ size_t numCompilations; /* Number of ByteCodes created. */ size_t numByteCodesFreed; /* Number of ByteCodes destroyed. */ - size_t instructionCount[256]; /* Number of times each instruction was + size_t instructionCount[256]; + /* Number of times each instruction was * executed. */ double totalSrcBytes; /* Total source bytes ever compiled. */ @@ -1705,7 +1705,7 @@ typedef struct ByteCodeStats { double currentSrcBytes; /* Src bytes for all current ByteCodes. */ double currentByteCodeBytes;/* Code bytes in all current ByteCodes. */ - size_t srcCount[32]; /* Source size distribution: # of srcs of + size_t srcCount[32]; /* Source size distribution: # of srcs of * size [2**(n-1)..2**n), n in [0..32). */ size_t byteCodeCount[32]; /* ByteCode size distribution. */ size_t lifetimeCount[32]; /* ByteCode lifetime distribution (ms). */ @@ -1735,7 +1735,7 @@ typedef struct { Tcl_ObjCmdProc *proc; /* The implementation of the subcommand. */ CompileProc *compileProc; /* The compiler for the subcommand. */ Tcl_ObjCmdProc *nreProc; /* NRE implementation of this command. */ - void *clientData; /* Any clientData to give the command. */ + void *clientData; /* Any clientData to give the command. */ int unsafe; /* Whether this command is to be hidden by * default in a safe interpreter. */ } EnsembleImplMap; @@ -1814,11 +1814,11 @@ typedef struct Command { Tcl_ObjCmdProc *objProc; /* Object-based command procedure. */ void *objClientData; /* Arbitrary value passed to object proc. */ Tcl_CmdProc *proc; /* String-based command procedure. */ - void *clientData; /* Arbitrary value passed to string proc. */ + void *clientData; /* Arbitrary value passed to string proc. */ Tcl_CmdDeleteProc *deleteProc; /* Procedure invoked when deleting command to, * e.g., free all client data. */ - void *deleteData; /* Arbitrary value passed to deleteProc. */ + void *deleteData; /* Arbitrary value passed to deleteProc. */ int flags; /* Miscellaneous bits of information about * command. See below for definitions. */ ImportRef *importRefPtr; /* List of each imported Command created in @@ -1857,14 +1857,13 @@ typedef struct Command { * (these last two flags are defined in tcl.h) */ -#define CMD_DYING 0x01 -#define CMD_TRACE_ACTIVE 0x02 -#define CMD_HAS_EXEC_TRACES 0x04 -#define CMD_COMPILES_EXPANDED 0x08 -#define CMD_REDEF_IN_PROGRESS 0x10 -#define CMD_VIA_RESOLVER 0x20 -#define CMD_DEAD 0x40 - +#define CMD_DYING 0x01 +#define CMD_TRACE_ACTIVE 0x02 +#define CMD_HAS_EXEC_TRACES 0x04 +#define CMD_COMPILES_EXPANDED 0x08 +#define CMD_REDEF_IN_PROGRESS 0x10 +#define CMD_VIA_RESOLVER 0x20 +#define CMD_DEAD 0x40 /* *---------------------------------------------------------------- @@ -1964,8 +1963,7 @@ typedef struct Interp { * enabled extensions check for a NULL pointer value * and for a TCL_STUBS_MAGIC value to verify they * are not [load]ing into one of those pre-stubs - * interps. - */ + * interps. */ TclHandle handle; /* Handle used to keep track of when this * interp is deleted. */ @@ -1975,7 +1973,7 @@ typedef struct Interp { /* Hash table used by tclBasic.c to keep track * of hidden commands on a per-interp * basis. */ - void *interpInfo; /* Information used by tclInterp.c to keep + void *interpInfo; /* Information used by tclInterp.c to keep * track of parent/child interps on a * per-interp basis. */ #if TCL_MAJOR_VERSION > 8 @@ -2054,7 +2052,7 @@ typedef struct Interp { * compiled by the interpreter. Indexed by the * string representations of literals. Used to * avoid creating duplicate objects. */ - Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for + Tcl_Size compileEpoch; /* Holds the current "compilation epoch" for * this interpreter. This is incremented to * invalidate existing ByteCodes when, e.g., a * command with a compile procedure is @@ -2064,8 +2062,7 @@ typedef struct Interp { * NULL. Set by ObjInterpProc in tclProc.c and * used by tclCompile.c to process local * variables appropriately. */ - ResolverScheme *resolverPtr; - /* Linked list of name resolution schemes + ResolverScheme *resolverPtr;/* Linked list of name resolution schemes * added to this interpreter. Schemes are * added and removed by calling * Tcl_AddInterpResolvers and @@ -2100,8 +2097,8 @@ typedef struct Interp { ActiveInterpTrace *activeInterpTracePtr; /* First in list of active traces for interp, * or NULL if no active traces. */ - - Tcl_Size tracesForbiddingInline; /* Count of traces (in the list headed by + Tcl_Size tracesForbiddingInline; + /* Count of traces (in the list headed by * tracePtr) that forbid inline bytecode * compilation. */ @@ -2131,7 +2128,7 @@ typedef struct Interp { * as flag values the same as the 'active' * field. */ - Tcl_Size cmdCount; /* Limit for how many commands to execute in + Tcl_Size cmdCount; /* Limit for how many commands to execute in * the interpreter. */ LimitHandler *cmdHandlers; /* Handlers to execute when the limit is @@ -2167,9 +2164,9 @@ typedef struct Interp { * *root* ensemble command? (Nested ensembles * don't rewrite this.) NULL if we're not * processing an ensemble. */ - Tcl_Size numRemovedObjs; /* How many arguments have been stripped off + Tcl_Size numRemovedObjs;/* How many arguments have been stripped off * because of ensemble processing. */ - Tcl_Size numInsertedObjs; /* How many of the current arguments were + Tcl_Size numInsertedObjs;/* How many of the current arguments were * inserted by an ensemble. */ } ensembleRewrite; @@ -2208,7 +2205,7 @@ typedef struct Interp { * Proc structure for a procedure. The values * are "struct ExtCmdLoc*". (See * tclCompile.h) */ - Tcl_HashTable *lineLABCPtr; + Tcl_HashTable *lineLABCPtr; /* Tcl_Obj* (by exact pointer) -> CFWordBC* */ Tcl_HashTable *lineLAPtr; /* This table remembers for each argument of a * command on the execution stack the index of * the argument in the command, and the @@ -2229,8 +2226,7 @@ typedef struct Interp { * used by function ...() in the same file. * It does for the eval/direct path of script * execution what CompileEnv.clLoc does for - * the bytecode compiler. - */ + * the bytecode compiler. */ /* * TIP #268. The currently active selection mode, i.e. the package require * preferences. @@ -2302,7 +2298,7 @@ typedef struct Interp { Tcl_Obj *callLiteral; /* "CALL" literal for [info errorstack] */ Tcl_Obj *innerLiteral; /* "INNER" literal for [info errorstack] */ Tcl_Obj *innerContext; /* cached list for fast reallocation */ - int resetErrorStack; /* controls cleaning up of ::errorStack */ + int resetErrorStack; /* controls cleaning up of ::errorStack */ #ifdef TCL_COMPILE_STATS /* @@ -2329,10 +2325,10 @@ typedef struct Interp { #define TclCanceled(iPtr) \ (((iPtr)->flags & CANCELED) || ((iPtr)->flags & TCL_CANCEL_UNWIND)) -#define TclSetCancelFlags(iPtr, cancelFlags) \ - (iPtr)->flags |= CANCELED; \ - if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ - (iPtr)->flags |= TCL_CANCEL_UNWIND; \ +#define TclSetCancelFlags(iPtr, cancelFlags) \ + (iPtr)->flags |= CANCELED; \ + if ((cancelFlags) & TCL_CANCEL_UNWIND) { \ + (iPtr)->flags |= TCL_CANCEL_UNWIND; \ } #define TclUnsetCancelFlags(iPtr) \ @@ -2494,7 +2490,8 @@ struct TclMaxAlignment { */ #define TclOOM(ptr, size) \ - ((size) && ((ptr)||(Tcl_Panic("unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)),1))) + ((size) && ((ptr) || (Tcl_Panic( \ + "unable to alloc %" TCL_Z_MODIFIER "u bytes", (size_t)(size)), 1))) /* * The following enum values are used to specify the runtime platform setting @@ -2564,36 +2561,38 @@ typedef enum TclEolTranslation { * */ typedef struct ListStore { - Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ - Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ - Tcl_Size numAllocated; /* Total number of slots[] array slots. */ - size_t refCount; /* Number of references to this instance */ - int flags; /* LISTSTORE_* flags */ - Tcl_Obj *slots[TCLFLEXARRAY]; /* Variable size array. Grown as needed */ + Tcl_Size firstUsed; /* Index of first slot in use within slots[] */ + Tcl_Size numUsed; /* Number of slots in use (starting firstUsed) */ + Tcl_Size numAllocated; /* Total number of slots[] array slots. */ + size_t refCount; /* Number of references to this instance. */ + int flags; /* LISTSTORE_* flags */ + Tcl_Obj *slots[TCLFLEXARRAY]; + /* Variable size array. Grown as needed */ } ListStore; #define LISTSTORE_CANONICAL 0x1 /* All Tcl_Obj's referencing this - store have their string representation - derived from the list representation */ + * store have their string representation + * derived from the list representation */ /* Max number of elements that can be contained in a list */ -#define LIST_MAX \ - ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ - / sizeof(Tcl_Obj *))) +#define LIST_MAX \ + ((Tcl_Size)(((size_t)TCL_SIZE_MAX - offsetof(ListStore, slots)) \ + / sizeof(Tcl_Obj *))) /* Memory size needed for a ListStore to hold numSlots_ elements */ #define LIST_SIZE(numSlots_) \ - ((Tcl_Size)(offsetof(ListStore, slots) + ((numSlots_) * sizeof(Tcl_Obj *)))) + ((Tcl_Size)(offsetof(ListStore, slots) \ + + ((numSlots_) * sizeof(Tcl_Obj *)))) /* * ListSpan -- * See comments above for ListStore */ typedef struct ListSpan { - Tcl_Size spanStart; /* Starting index of the span */ - Tcl_Size spanLength; /* Number of elements in the span */ - size_t refCount; /* Count of references to this span record */ + Tcl_Size spanStart; /* Starting index of the span. */ + Tcl_Size spanLength; /* Number of elements in the span. */ + size_t refCount; /* Count of references to this span record. */ } ListSpan; -#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ +#ifndef LIST_SPAN_THRESHOLD /* May be set on build line */ #define LIST_SPAN_THRESHOLD 101 #endif @@ -2602,9 +2601,11 @@ typedef struct ListSpan { * See comments above for ListStore */ typedef struct ListRep { - ListStore *storePtr;/* element array shared amongst different lists */ - ListSpan *spanPtr; /* If not NULL, the span holds the range of slots - within *storePtr that contain this list elements. */ + ListStore *storePtr; /* element array shared amongst different + * lists */ + ListSpan *spanPtr; /* If not NULL, the span holds the range of + * slots within *storePtr that contain this + * list elements. */ } ListRep; /* @@ -2620,14 +2621,16 @@ typedef struct ListRep { */ /* Returns the starting slot for this listRep in the contained ListStore */ -#define ListRepStart(listRepPtr_) \ - ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanStart \ - : (listRepPtr_)->storePtr->firstUsed) +#define ListRepStart(listRepPtr_) \ + ((listRepPtr_)->spanPtr \ + ? (listRepPtr_)->spanPtr->spanStart \ + : (listRepPtr_)->storePtr->firstUsed) /* Returns the number of elements in this listRep */ -#define ListRepLength(listRepPtr_) \ - ((listRepPtr_)->spanPtr ? (listRepPtr_)->spanPtr->spanLength \ - : (listRepPtr_)->storePtr->numUsed) +#define ListRepLength(listRepPtr_) \ + ((listRepPtr_)->spanPtr \ + ? (listRepPtr_)->spanPtr->spanLength \ + : (listRepPtr_)->storePtr->numUsed) /* Returns a pointer to the first slot containing this ListRep elements */ #define ListRepElementsBase(listRepPtr_) \ @@ -2635,7 +2638,7 @@ typedef struct ListRep { /* Stores the number of elements and base address of the element array */ #define ListRepElements(listRepPtr_, objc_, objv_) \ - (((objv_) = ListRepElementsBase(listRepPtr_)), \ + (((objv_) = ListRepElementsBase(listRepPtr_)), \ ((objc_) = ListRepLength(listRepPtr_))) /* Returns 1/0 whether the ListRep's ListStore is shared. */ @@ -2650,34 +2653,36 @@ typedef struct ListRep { ((ListSpan *)((listObj_)->internalRep.twoPtrValue.ptr2)) /* Returns the ListRep internal representaton in a Tcl_Obj */ -#define ListObjGetRep(listObj_, listRepPtr_) \ - do { \ - (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ - (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ +#define ListObjGetRep(listObj_, listRepPtr_) \ + do { \ + (listRepPtr_)->storePtr = ListObjStorePtr(listObj_); \ + (listRepPtr_)->spanPtr = ListObjSpanPtr(listObj_); \ } while (0) /* Returns the length of the list */ -#define ListObjLength(listObj_, len_) \ - ((len_) = ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanLength \ - : ListObjStorePtr(listObj_)->numUsed) +#define ListObjLength(listObj_, len_) \ + ((len_) = ListObjSpanPtr(listObj_) \ + ? ListObjSpanPtr(listObj_)->spanLength \ + : ListObjStorePtr(listObj_)->numUsed) /* Returns the starting slot index of this list's elements in the ListStore */ -#define ListObjStart(listObj_) \ - (ListObjSpanPtr(listObj_) ? ListObjSpanPtr(listObj_)->spanStart \ - : ListObjStorePtr(listObj_)->firstUsed) +#define ListObjStart(listObj_) \ + (ListObjSpanPtr(listObj_) \ + ? ListObjSpanPtr(listObj_)->spanStart \ + : ListObjStorePtr(listObj_)->firstUsed) /* Stores the element count and base address of this list's elements */ #define ListObjGetElements(listObj_, objc_, objv_) \ (((objv_) = &ListObjStorePtr(listObj_)->slots[ListObjStart(listObj_)]), \ (ListObjLength(listObj_, (objc_)))) - /* * Returns 1/0 whether the internal representation (not the Tcl_Obj itself) * is shared. Note by intent this only checks for sharing of ListStore, * not spans. */ -#define ListObjRepIsShared(listObj_) (ListObjStorePtr(listObj_)->refCount > 1) +#define ListObjRepIsShared(listObj_) \ + (ListObjStorePtr(listObj_)->refCount > 1) /* * Certain commands like concat are optimized if an existing string @@ -2694,10 +2699,10 @@ typedef struct ListRep { * and never from strings (see SetListFromAny) and thus their string * representation will always be canonical. */ -#define ListObjIsCanonical(listObj_) \ - (((listObj_)->bytes == NULL) \ - || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ - || ListObjSpanPtr(listObj_) != NULL) +#define ListObjIsCanonical(listObj_) \ + (((listObj_)->bytes == NULL) \ + || (ListObjStorePtr(listObj_)->flags & LISTSTORE_CANONICAL) \ + || ListObjSpanPtr(listObj_) != NULL) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element @@ -2705,25 +2710,27 @@ typedef struct ListRep { * Return TCL_OK on success or TCL_ERROR if the Tcl_Obj cannot be * converted to a list. */ -#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ - TCL_OK) \ - : Tcl_ListObjGetElements( \ - (interp_), (listObj_), (objcPtr_), (objvPtr_))) +#define TclListObjGetElements(interp_, listObj_, objcPtr_, objvPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjGetElements((listObj_), *(objcPtr_), *(objvPtr_))), \ + TCL_OK) \ + : Tcl_ListObjGetElements( \ + (interp_), (listObj_), (objcPtr_), (objvPtr_))) /* * Converts the Tcl_Obj to a list if it isn't one and stores the element * count in lenPtr_. Returns TCL_OK on success or TCL_ERROR if the * Tcl_Obj cannot be converted to a list. */ -#define TclListObjLength(interp_, listObj_, lenPtr_) \ - ((TclHasInternalRep((listObj_), &tclListType)) \ - ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ - : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) +#define TclListObjLength(interp_, listObj_, lenPtr_) \ + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ((ListObjLength((listObj_), *(lenPtr_))), TCL_OK) \ + : Tcl_ListObjLength((interp_), (listObj_), (lenPtr_))) #define TclListObjIsCanonical(listObj_) \ - ((TclHasInternalRep((listObj_), &tclListType)) ? ListObjIsCanonical((listObj_)) : 0) + ((TclHasInternalRep((listObj_), &tclListType)) \ + ? ListObjIsCanonical((listObj_)) \ + : 0) /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, @@ -2743,44 +2750,45 @@ typedef struct ListRep { #if TCL_MAJOR_VERSION > 8 #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ - || TclHasInternalRep((objPtr), &tclBooleanType)) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ + || TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #else #define TclGetBooleanFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ + ((TclHasInternalRep((objPtr), &tclIntType)) \ ? (*(intPtr) = ((objPtr)->internalRep.wideValue!=0), TCL_OK) \ - : (TclHasInternalRep((objPtr), &tclBooleanType)) \ + : (TclHasInternalRep((objPtr), &tclBooleanType)) \ ? (*(intPtr) = ((objPtr)->internalRep.longValue!=0), TCL_OK) \ : Tcl_GetBooleanFromObj((interp), (objPtr), (intPtr))) #endif #ifdef TCL_WIDE_INT_IS_LONG #define TclGetLongFromObj(interp, objPtr, longPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ - ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) + ((TclHasInternalRep((objPtr), &tclIntType)) \ + ? ((*(longPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #else #define TclGetLongFromObj(interp, objPtr, longPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(LONG_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(LONG_MAX)) \ - ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) + ? ((*(longPtr) = (long)(objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetLongFromObj((interp), (objPtr), (longPtr))) #endif #define TclGetIntFromObj(interp, objPtr, intPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType) \ + ((TclHasInternalRep((objPtr), &tclIntType) \ && (objPtr)->internalRep.wideValue >= (Tcl_WideInt)(INT_MIN) \ && (objPtr)->internalRep.wideValue <= (Tcl_WideInt)(INT_MAX)) \ - ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) + ? ((*(intPtr) = (int)(objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetIntFromObj((interp), (objPtr), (intPtr))) #define TclGetIntForIndexM(interp, objPtr, endValue, idxPtr) \ - (((TclHasInternalRep((objPtr), &tclIntType)) && ((objPtr)->internalRep.wideValue >= 0) \ - && ((objPtr)->internalRep.wideValue <= endValue)) \ - ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ - : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) + (((TclHasInternalRep((objPtr), &tclIntType)) \ + && ((objPtr)->internalRep.wideValue >= 0) \ + && ((objPtr)->internalRep.wideValue <= endValue)) \ + ? ((*(idxPtr) = (objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetIntForIndex((interp), (objPtr), (endValue), (idxPtr))) /* * Macro used to save a function call for common uses of @@ -2791,10 +2799,9 @@ typedef struct ListRep { */ #define TclGetWideIntFromObj(interp, objPtr, wideIntPtr) \ - ((TclHasInternalRep((objPtr), &tclIntType)) \ - ? (*(wideIntPtr) = \ - ((objPtr)->internalRep.wideValue), TCL_OK) : \ - Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) + ((TclHasInternalRep((objPtr), &tclIntType)) \ + ? (*(wideIntPtr) = ((objPtr)->internalRep.wideValue), TCL_OK) \ + : Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr))) /* * Flag values for TclTraceDictPath(). @@ -2839,7 +2846,8 @@ typedef struct ListRep { #define TCL_FILESYSTEM_VERSION_2 ((Tcl_FSVersion) 0x2) typedef void *(TclFSGetCwdProc2)(void *clientData); typedef int (Tcl_FSLoadFileProc2) (Tcl_Interp *interp, Tcl_Obj *pathPtr, - Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, int flags); + Tcl_LoadHandle *handlePtr, Tcl_FSUnloadFileProc **unloadProcPtr, + int flags); /* * The following types are used for getting and storing platform-specific file @@ -2890,13 +2898,14 @@ typedef Tcl_Channel (TclOpenFileChannelProc_)(Tcl_Interp *interp, *---------------------------------------------------------------- */ -typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *lengthPtr, +typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, + TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); #ifdef _WIN32 # define TCLFSENCODING tclUtf8Encoding /* On Windows, all Unicode (except surrogates) are valid */ #else -# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ +# define TCLFSENCODING NULL /* On Non-Windows, use the system encoding for validation checks */ #endif /* @@ -2908,7 +2917,7 @@ typedef void (TclInitProcessGlobalValueProc)(char **valuePtr, TCL_HASH_TYPE *len */ typedef struct ProcessGlobalValue { - Tcl_Size epoch; /* Epoch counter to detect changes in the + Tcl_Size epoch; /* Epoch counter to detect changes in the * global value. */ TCL_HASH_TYPE numBytes; /* Length of the global string. */ char *value; /* The global string value. */ @@ -2930,26 +2939,25 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ -#define TCL_PARSE_DECIMAL_ONLY 1 +#define TCL_PARSE_DECIMAL_ONLY 1 /* Leading zero doesn't denote octal or * hex. */ -#define TCL_PARSE_OCTAL_ONLY 2 +#define TCL_PARSE_OCTAL_ONLY 2 /* Parse octal even without prefix. */ #define TCL_PARSE_HEXADECIMAL_ONLY 4 /* Parse hexadecimal even without prefix. */ -#define TCL_PARSE_INTEGER_ONLY 8 +#define TCL_PARSE_INTEGER_ONLY 8 /* Disable floating point parsing. */ -#define TCL_PARSE_SCAN_PREFIXES 16 +#define TCL_PARSE_SCAN_PREFIXES 16 /* Use [scan] rules dealing with 0? * prefixes. */ -#define TCL_PARSE_NO_WHITESPACE 32 +#define TCL_PARSE_NO_WHITESPACE 32 /* Reject leading/trailing whitespace. */ #define TCL_PARSE_BINARY_ONLY 64 /* Parse binary even without prefix. */ #define TCL_PARSE_NO_UNDERSCORE 128 /* Reject underscore digit separator */ - /* *---------------------------------------------------------------------- * Internal convenience macros for manipulating encoding flags. See @@ -2958,11 +2966,12 @@ typedef struct ProcessGlobalValue { */ #define ENCODING_PROFILE_MASK 0xFF000000 -#define ENCODING_PROFILE_GET(flags_) ((flags_) & ENCODING_PROFILE_MASK) -#define ENCODING_PROFILE_SET(flags_, profile_) \ - do { \ - (flags_) &= ~ENCODING_PROFILE_MASK; \ - (flags_) |= ((profile_) & ENCODING_PROFILE_MASK);\ +#define ENCODING_PROFILE_GET(flags_) \ + ((flags_) & ENCODING_PROFILE_MASK) +#define ENCODING_PROFILE_SET(flags_, profile_) \ + do { \ + (flags_) &= ~ENCODING_PROFILE_MASK; \ + (flags_) |= ((profile_) & ENCODING_PROFILE_MASK); \ } while (0) /* @@ -2977,22 +2986,26 @@ typedef struct ProcessGlobalValue { *---------------------------------------------------------------------- */ static inline Tcl_Size -TclUpsizeAlloc(TCL_UNUSED(Tcl_Size) /* oldSize. For future experiments with - * some growth algorithms that use this - * information. */, - Tcl_Size needed, - Tcl_Size limit) +TclUpsizeAlloc( + TCL_UNUSED(Tcl_Size), /* oldSize. For future experiments with + * some growth algorithms that use this + * information. */ + Tcl_Size needed, + Tcl_Size limit) { /* assert (oldCapacity < needed <= limit) */ if (needed < (limit - needed/2)) { return needed + needed / 2; - } - else { + } else { return limit; } } -static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) { - /* assert (needed < lastAttempt) */ +static inline Tcl_Size +TclUpsizeRetry( + Tcl_Size needed, + Tcl_Size lastAttempt) +{ + /* assert(needed < lastAttempt); */ if (needed < lastAttempt - 1) { /* (needed+lastAttempt)/2 but that formula may overflow Tcl_Size */ return needed + (lastAttempt - needed) / 2; @@ -3000,37 +3013,58 @@ static inline Tcl_Size TclUpsizeRetry(Tcl_Size needed, Tcl_Size lastAttempt) { return needed; } } -MODULE_SCOPE void *TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); -MODULE_SCOPE void *TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, - Tcl_Size elemSize, Tcl_Size leadSize, - Tcl_Size *capacityPtr); -MODULE_SCOPE void *TclAttemptReallocElemsEx(void *oldPtr, - Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclReallocElemsEx(void *oldPtr, Tcl_Size elemCount, + Tcl_Size elemSize, Tcl_Size leadSize, + Tcl_Size *capacityPtr); +MODULE_SCOPE void * TclAttemptReallocElemsEx(void *oldPtr, + Tcl_Size elemCount, Tcl_Size elemSize, + Tcl_Size leadSize, Tcl_Size *capacityPtr); /* Alloc elemCount elements of size elemSize with leadSize header * returning actual capacity (in elements) in *capacityPtr. */ -static inline void *TclAttemptAllocElemsEx(Tcl_Size elemCount, Tcl_Size elemSize, - Tcl_Size leadSize, Tcl_Size *capacityPtr) { +static inline void * +TclAttemptAllocElemsEx( + Tcl_Size elemCount, + Tcl_Size elemSize, + Tcl_Size leadSize, + Tcl_Size *capacityPtr) +{ return TclAttemptReallocElemsEx( - NULL, elemCount, elemSize, leadSize, capacityPtr); + NULL, elemCount, elemSize, leadSize, capacityPtr); } /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclAllocEx( + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclAllocElemsEx(numBytes, 1, 0, capacityPtr); } /* Alloc numByte bytes, returning actual capacity in *capacityPtr. */ static inline void * -TclAttemptAllocEx(Tcl_Size numBytes, Tcl_Size *capacityPtr) +TclAttemptAllocEx( + Tcl_Size numBytes, + Tcl_Size *capacityPtr) { return TclAttemptAllocElemsEx(numBytes, 1, 0, capacityPtr); } /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclReallocEx( + void *oldPtr, + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } /* Realloc numByte bytes, returning actual capacity in *capacityPtr. */ -static inline void *TclAttemptReallocEx(void *oldPtr, Tcl_Size numBytes, Tcl_Size *capacityPtr) { +static inline void * +TclAttemptReallocEx( + void *oldPtr, + Tcl_Size numBytes, + Tcl_Size *capacityPtr) +{ return TclAttemptReallocElemsEx(oldPtr, numBytes, 1, 0, capacityPtr); } @@ -3051,13 +3085,12 @@ MODULE_SCOPE TclPlatformType tclPlatform; MODULE_SCOPE Tcl_Encoding tclIdentityEncoding; MODULE_SCOPE Tcl_Encoding tclUtf8Encoding; -MODULE_SCOPE int -TclEncodingProfileNameToId(Tcl_Interp *interp, - const char *profileName, - int *profilePtr); +MODULE_SCOPE int TclEncodingProfileNameToId(Tcl_Interp *interp, + const char *profileName, + int *profilePtr); MODULE_SCOPE const char *TclEncodingProfileIdToName(Tcl_Interp *interp, - int profileId); -MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); + int profileId); +MODULE_SCOPE void TclGetEncodingProfiles(Tcl_Interp *interp); /* * TIP #233 (Virtualized Time) @@ -3155,12 +3188,13 @@ MODULE_SCOPE Tcl_ObjCmdProc TclNRYieldToObjCmd; MODULE_SCOPE Tcl_ObjCmdProc TclNRInvoke; MODULE_SCOPE Tcl_NRPostProc TclNRReleaseValues; -MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, Tcl_Obj *tailcallPtr); -MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); +MODULE_SCOPE void TclSetTailcall(Tcl_Interp *interp, + Tcl_Obj *tailcallPtr); +MODULE_SCOPE void TclPushTailcallPoint(Tcl_Interp *interp); /* These two can be considered for the public api */ -MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); -MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclMarkTailcall(Tcl_Interp *interp); +MODULE_SCOPE void TclSkipTailcall(Tcl_Interp *interp); /* * This structure holds the data for the various iteration callbacks used to @@ -3177,7 +3211,7 @@ typedef struct ForIterData { Tcl_Obj *body; /* Loop body. */ Tcl_Obj *next; /* Loop step script, NULL for 'while'. */ const char *msg; /* Error message part. */ - Tcl_Size word; /* Index of the body script in the command */ + Tcl_Size word; /* Index of the body script in the command */ } ForIterData; /* TIP #357 - Structure doing the bookkeeping of handles for Tcl_LoadFile @@ -3185,9 +3219,9 @@ typedef struct ForIterData { * typedef in tcl.h */ typedef void* TclFindSymbolProc(Tcl_Interp* interp, Tcl_LoadHandle loadHandle, - const char* symbol); + const char* symbol); struct Tcl_LoadHandle_ { - void *clientData; /* Client data is the load handle in the + void *clientData; /* Client data is the load handle in the * native filesystem if a module was loaded * there, or an opaque pointer to a structure * for further bookkeeping on load-from-VFS @@ -3201,16 +3235,12 @@ struct Tcl_LoadHandle_ { /* Flags for conversion of doubles to digit strings */ -#define TCL_DD_E_FORMAT 0x2 - /* Use a fixed-length string of digits, +#define TCL_DD_E_FORMAT 0x2 /* Use a fixed-length string of digits, * suitable for E format*/ -#define TCL_DD_F_FORMAT 0x3 - /* Use a fixed number of digits after the +#define TCL_DD_F_FORMAT 0x3 /* Use a fixed number of digits after the * decimal point, suitable for F format */ -#define TCL_DD_SHORTEST 0x4 - /* Use the shortest possible string */ -#define TCL_DD_NO_QUICK 0x8 - /* Debug flag: forbid quick FP conversion */ +#define TCL_DD_SHORTEST 0x4 /* Use the shortest possible string */ +#define TCL_DD_NO_QUICK 0x8 /* Debug flag: forbid quick FP conversion */ #define TCL_DD_CONVERSION_TYPE_MASK 0x3 /* Mask to isolate the conversion type */ @@ -3231,12 +3261,13 @@ MODULE_SCOPE void TclAppendBytesToByteArray(Tcl_Obj *objPtr, MODULE_SCOPE void TclAppendUtfToUtf(Tcl_Obj *objPtr, const char *bytes, Tcl_Size numBytes); MODULE_SCOPE void TclArgumentEnter(Tcl_Interp *interp, - Tcl_Obj *objv[], int objc, CmdFrame *cf); + Tcl_Obj *objv[], Tcl_Size objc, CmdFrame *cf); MODULE_SCOPE void TclArgumentRelease(Tcl_Interp *interp, - Tcl_Obj *objv[], int objc); + Tcl_Obj *objv[], Tcl_Size objc); MODULE_SCOPE void TclArgumentBCEnter(Tcl_Interp *interp, - Tcl_Obj *objv[], int objc, - void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, Tcl_Size pc); + Tcl_Obj *objv[], Tcl_Size objc, + void *codePtr, CmdFrame *cfPtr, Tcl_Size cmd, + Tcl_Size pc); MODULE_SCOPE void TclArgumentBCRelease(Tcl_Interp *interp, CmdFrame *cfPtr); MODULE_SCOPE void TclArgumentGet(Tcl_Interp *interp, Tcl_Obj *obj, @@ -3309,7 +3340,8 @@ MODULE_SCOPE char * TclDStringAppendObj(Tcl_DString *dsPtr, MODULE_SCOPE char * TclDStringAppendDString(Tcl_DString *dsPtr, Tcl_DString *toAppendPtr); MODULE_SCOPE Tcl_Obj *const *TclFetchEnsembleRoot(Tcl_Interp *interp, - Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size *objcPtr); + Tcl_Obj *const *objv, Tcl_Size objc, + Tcl_Size *objcPtr); MODULE_SCOPE Tcl_Obj *const *TclEnsembleGetRewriteValues(Tcl_Interp *interp); MODULE_SCOPE Tcl_Namespace *TclEnsureNamespace(Tcl_Interp *interp, Tcl_Namespace *namespacePtr); @@ -3356,7 +3388,7 @@ MODULE_SCOPE int TclGetCompletionCodeFromObj(Tcl_Interp *interp, MODULE_SCOPE Proc * TclGetLambdaFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj **nsObjPtrPtr); MODULE_SCOPE Tcl_Obj * TclGetProcessGlobalValue(ProcessGlobalValue *pgvPtr); -MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, int objc, +MODULE_SCOPE Tcl_Obj * TclGetSourceFromFrame(CmdFrame *cfPtr, Tcl_Size objc, Tcl_Obj *const objv[]); MODULE_SCOPE char * TclGetStringStorage(Tcl_Obj *objPtr, Tcl_Size *sizePtr); @@ -3424,7 +3456,7 @@ MODULE_SCOPE Tcl_Size TclMaxListLength(const char *bytes, Tcl_Size numBytes, MODULE_SCOPE int TclMergeReturnOptions(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Obj **optionsPtrPtr, int *codePtr, int *levelPtr); -MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); +MODULE_SCOPE Tcl_Obj * TclNoErrorStack(Tcl_Interp *interp, Tcl_Obj *options); MODULE_SCOPE int TclNokia770Doubles(void); MODULE_SCOPE void TclNsDecrRefCount(Namespace *nsPtr); MODULE_SCOPE int TclNamespaceDeleted(Namespace *nsPtr); @@ -3449,15 +3481,16 @@ MODULE_SCOPE int TclProcessReturn(Tcl_Interp *interp, MODULE_SCOPE void TclUndoRefCount(Tcl_Obj *objPtr); MODULE_SCOPE int TclpObjLstat(Tcl_Obj *pathPtr, Tcl_StatBuf *buf); MODULE_SCOPE Tcl_Obj * TclpTempFileName(void); -MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, +MODULE_SCOPE Tcl_Obj * TclpTempFileNameForLibrary(Tcl_Interp *interp, Tcl_Obj* pathPtr); -MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, Tcl_Obj **arithSeriesPtr, - int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, - Tcl_Obj *stepObj, Tcl_Obj *lenObj); +MODULE_SCOPE int TclNewArithSeriesObj(Tcl_Interp *interp, + Tcl_Obj **arithSeriesPtr, + int useDoubles, Tcl_Obj *startObj, Tcl_Obj *endObj, + Tcl_Obj *stepObj, Tcl_Obj *lenObj); MODULE_SCOPE Tcl_Obj * TclNewFSPathObj(Tcl_Obj *dirPtr, const char *addStrRep, Tcl_Size len); MODULE_SCOPE void TclpAlertNotifier(void *clientData); -MODULE_SCOPE void *TclpNotifierData(void); +MODULE_SCOPE void * TclpNotifierData(void); MODULE_SCOPE void TclpServiceModeHook(int mode); MODULE_SCOPE void TclpSetTimer(const Tcl_Time *timePtr); MODULE_SCOPE int TclpWaitForEvent(const Tcl_Time *timePtr); @@ -3475,6 +3508,7 @@ MODULE_SCOPE void TclInitSockets(void); #else #define TclInitSockets() /* do nothing */ #endif +struct addrinfo; /* forward declaration, needed for TclCreateSocketAddress */ MODULE_SCOPE int TclCreateSocketAddress(Tcl_Interp *interp, struct addrinfo **addrlist, const char *host, int port, int willBind, @@ -3486,7 +3520,7 @@ MODULE_SCOPE Tcl_Size TclpFindVariable(const char *name, Tcl_Size *lengthPtr); MODULE_SCOPE void TclpInitLibraryPath(char **valuePtr, TCL_HASH_TYPE *lengthPtr, Tcl_Encoding *encodingPtr); MODULE_SCOPE void TclpInitLock(void); -MODULE_SCOPE void *TclpInitNotifier(void); +MODULE_SCOPE void * TclpInitNotifier(void); MODULE_SCOPE void TclpInitPlatform(void); MODULE_SCOPE void TclpInitUnlock(void); MODULE_SCOPE Tcl_Obj * TclpObjListVolumes(void); @@ -3568,13 +3602,14 @@ MODULE_SCOPE int TclSubstTokens(Tcl_Interp *interp, Tcl_Token *tokenPtr, Tcl_Size count, int *tokensLeftPtr, Tcl_Size line, Tcl_Size *clNextOuter, const char *outerScript); MODULE_SCOPE Tcl_Size TclTrim(const char *bytes, Tcl_Size numBytes, - const char *trim, Tcl_Size numTrim, Tcl_Size *trimRight); + const char *trim, Tcl_Size numTrim, + Tcl_Size *trimRight); MODULE_SCOPE Tcl_Size TclTrimLeft(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE Tcl_Size TclTrimRight(const char *bytes, Tcl_Size numBytes, const char *trim, Tcl_Size numTrim); MODULE_SCOPE const char*TclGetCommandTypeName(Tcl_Command command); -MODULE_SCOPE int TclObjInterpProc(void *clientData, +MODULE_SCOPE int TclObjInterpProc(void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); MODULE_SCOPE void TclRegisterCommandTypeName( @@ -3600,16 +3635,16 @@ MODULE_SCOPE void TclFinalizeThreadDataThread(void); MODULE_SCOPE void TclFinalizeThreadStorage(void); #ifdef TCL_WIDE_CLICKS -MODULE_SCOPE long long TclpGetWideClicks(void); +MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClicksToNanoseconds(long long clicks); MODULE_SCOPE double TclpWideClickInMicrosec(void); #else # ifdef _WIN32 # define TCL_WIDE_CLICKS 1 -MODULE_SCOPE long long TclpGetWideClicks(void); +MODULE_SCOPE long long TclpGetWideClicks(void); MODULE_SCOPE double TclpWideClickInMicrosec(void); -# define TclpWideClicksToNanoseconds(clicks) \ - ((double)(clicks) * TclpWideClickInMicrosec() * 1000) +# define TclpWideClicksToNanoseconds(clicks) \ + ((double)(clicks) * TclpWideClickInMicrosec() * 1000) # endif #endif MODULE_SCOPE long long TclpGetMicroseconds(void); @@ -3633,8 +3668,8 @@ MODULE_SCOPE void TclZipfsFinalize(void); */ MODULE_SCOPE int TclIsSpaceProc(int byte); -# define TclIsSpaceProcM(byte) \ - (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) +#define TclIsSpaceProcM(byte) \ + (((byte) > 0x20) ? 0 : TclIsSpaceProc(byte)) /* *---------------------------------------------------------------- @@ -4003,14 +4038,13 @@ MODULE_SCOPE int TclFullFinalizationRequested(void); * TIP #542 */ -MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); -MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); -MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, - const Tcl_UniChar *uct, size_t numChars); -MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, - const Tcl_UniChar *uniPattern, int nocase); - +MODULE_SCOPE size_t TclUniCharLen(const Tcl_UniChar *uniStr); +MODULE_SCOPE int TclUniCharNcmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharNcasecmp(const Tcl_UniChar *ucs, + const Tcl_UniChar *uct, size_t numChars); +MODULE_SCOPE int TclUniCharCaseMatch(const Tcl_UniChar *uniStr, + const Tcl_UniChar *uniPattern, int nocase); /* * Just for the purposes of command-type registration. @@ -4069,13 +4103,14 @@ MODULE_SCOPE Tcl_Size TclIndexDecode(int encoded, Tcl_Size endValue); /* * Error message utility functions */ -MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, Tcl_Size count); +MODULE_SCOPE int TclCommandWordLimitError(Tcl_Interp *interp, + Tcl_Size count); #endif /* TCL_MAJOR_VERSION > 8 */ /* Constants used in index value encoding routines. */ -#define TCL_INDEX_END ((Tcl_Size)-2) -#define TCL_INDEX_START ((Tcl_Size)0) +#define TCL_INDEX_END ((Tcl_Size)-2) +#define TCL_INDEX_START ((Tcl_Size)0) /* *---------------------------------------------------------------------- @@ -4154,20 +4189,20 @@ TclScaleTime( # define TclIncrObjsFreed() #endif /* TCL_COMPILE_STATS */ -# define TclAllocObjStorage(objPtr) \ +# define TclAllocObjStorage(objPtr) \ TclAllocObjStorageEx(NULL, (objPtr)) -# define TclFreeObjStorage(objPtr) \ +# define TclFreeObjStorage(objPtr) \ TclFreeObjStorageEx(NULL, (objPtr)) #ifndef TCL_MEM_DEBUG # define TclNewObj(objPtr) \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = &tclEmptyString; \ - (objPtr)->length = 0; \ - (objPtr)->typePtr = NULL; \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = &tclEmptyString; \ + (objPtr)->length = 0; \ + (objPtr)->typePtr = NULL; \ TCL_DTRACE_OBJ_CREATE(objPtr) /* @@ -4178,19 +4213,19 @@ TclScaleTime( */ # define TclDecrRefCount(objPtr) \ - if ((objPtr)->refCount-- > 1) ; else { \ - if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ - TCL_DTRACE_OBJ_FREE(objPtr); \ - if ((objPtr)->bytes \ - && ((objPtr)->bytes != &tclEmptyString)) { \ - Tcl_Free((objPtr)->bytes); \ - } \ - (objPtr)->length = TCL_INDEX_NONE; \ - TclFreeObjStorage(objPtr); \ - TclIncrObjsFreed(); \ - } else { \ - TclFreeObj(objPtr); \ - } \ + if ((objPtr)->refCount-- > 1) ; else { \ + if (!(objPtr)->typePtr || !(objPtr)->typePtr->freeIntRepProc) { \ + TCL_DTRACE_OBJ_FREE(objPtr); \ + if ((objPtr)->bytes \ + && ((objPtr)->bytes != &tclEmptyString)) { \ + Tcl_Free((objPtr)->bytes); \ + } \ + (objPtr)->length = TCL_INDEX_NONE; \ + TclFreeObjStorage(objPtr); \ + TclIncrObjsFreed(); \ + } else { \ + TclFreeObj(objPtr); \ + } \ } #if TCL_THREADS && !defined(USE_THREAD_ALLOC) @@ -4297,11 +4332,11 @@ MODULE_SCOPE Tcl_Mutex tclObjMutex; } while (0) # define TclFreeObjStorageEx(interp, objPtr) \ - do { \ - Tcl_MutexLock(&tclObjMutex); \ + do { \ + Tcl_MutexLock(&tclObjMutex); \ (objPtr)->internalRep.twoPtrValue.ptr1 = (void *) tclFreeObjList; \ - tclFreeObjList = (objPtr); \ - Tcl_MutexUnlock(&tclObjMutex); \ + tclFreeObjList = (objPtr); \ + Tcl_MutexUnlock(&tclObjMutex); \ } while (0) #endif @@ -4352,27 +4387,26 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInitEmptyStringRep(objPtr) \ - ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0)) - + ((objPtr)->length = (((objPtr)->bytes = &tclEmptyString), 0)) #define TclInitStringRep(objPtr, bytePtr, len) \ - if ((len) == 0) { \ - TclInitEmptyStringRep(objPtr); \ - } else { \ - (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ + if ((len) == 0) { \ + TclInitEmptyStringRep(objPtr); \ + } else { \ + (objPtr)->bytes = (char *)Tcl_Alloc((len) + 1U); \ memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)); \ - (objPtr)->bytes[len] = '\0'; \ - (objPtr)->length = (len); \ + (objPtr)->bytes[len] = '\0'; \ + (objPtr)->length = (len); \ } #define TclAttemptInitStringRep(objPtr, bytePtr, len) \ - ((((len) == 0) ? ( \ - TclInitEmptyStringRep(objPtr) \ - ) : ( \ - (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ - (objPtr)->length = ((objPtr)->bytes) ? \ + ((((len) == 0) ? ( \ + TclInitEmptyStringRep(objPtr) \ + ) : ( \ + (objPtr)->bytes = (char *)Tcl_AttemptAlloc((len) + 1U), \ + (objPtr)->length = ((objPtr)->bytes) ? \ (memcpy((objPtr)->bytes, (bytePtr) ? (bytePtr) : &tclEmptyString, (len)), \ - (objPtr)->bytes[len] = '\0', (len)) : (-1) \ + (objPtr)->bytes[len] = '\0', (len)) : (-1) \ )), (objPtr)->bytes) /* @@ -4391,8 +4425,8 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, ((objPtr)->bytes? (objPtr)->bytes : Tcl_GetString(objPtr)) #define TclGetStringFromObj(objPtr, lenPtr) \ - ((objPtr)->bytes \ - ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ + ((objPtr)->bytes \ + ? (*(lenPtr) = (objPtr)->length, (objPtr)->bytes) \ : (Tcl_GetStringFromObj)((objPtr), (lenPtr))) /* @@ -4406,11 +4440,11 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclFreeInternalRep(objPtr) \ - if ((objPtr)->typePtr != NULL) { \ - if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ - (objPtr)->typePtr->freeIntRepProc(objPtr); \ - } \ - (objPtr)->typePtr = NULL; \ + if ((objPtr)->typePtr != NULL) { \ + if ((objPtr)->typePtr->freeIntRepProc != NULL) { \ + (objPtr)->typePtr->freeIntRepProc(objPtr); \ + } \ + (objPtr)->typePtr = NULL; \ } /* @@ -4423,14 +4457,14 @@ MODULE_SCOPE void TclDbInitNewObj(Tcl_Obj *objPtr, const char *file, */ #define TclInvalidateStringRep(objPtr) \ - do { \ - Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ - if (_isobjPtr->bytes != NULL) { \ - if (_isobjPtr->bytes != &tclEmptyString) { \ - Tcl_Free((char *)_isobjPtr->bytes); \ - } \ - _isobjPtr->bytes = NULL; \ - } \ + do { \ + Tcl_Obj *_isobjPtr = (Tcl_Obj *)(objPtr); \ + if (_isobjPtr->bytes != NULL) { \ + if (_isobjPtr->bytes != &tclEmptyString) { \ + Tcl_Free((char *)_isobjPtr->bytes); \ + } \ + _isobjPtr->bytes = NULL; \ + } \ } while (0) /* @@ -4473,8 +4507,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; #define TclUnpackBignum(objPtr, bignum) \ do { \ - Tcl_Obj *bignumObj = (objPtr); \ - int bignumPayload = \ + Tcl_Obj *bignumObj = (objPtr); \ + int bignumPayload = \ PTR2INT(bignumObj->internalRep.twoPtrValue.ptr2); \ if (bignumPayload == -1) { \ (bignum) = *((mp_int *) bignumObj->internalRep.twoPtrValue.ptr1); \ @@ -4527,16 +4561,16 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; oldPtr = NULL; \ } \ newPtr = (Tcl_Token *)Tcl_AttemptRealloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ if (newPtr == NULL) { \ allocated = _needed + (append) + TCL_MIN_TOKEN_GROWTH; \ newPtr = (Tcl_Token *)Tcl_Realloc((char *) oldPtr, \ - allocated * sizeof(Tcl_Token)); \ + allocated * sizeof(Tcl_Token)); \ } \ (available) = allocated; \ if (oldPtr == NULL) { \ memcpy(newPtr, staticPtr, \ - (used) * sizeof(Tcl_Token)); \ + (used) * sizeof(Tcl_Token)); \ } \ (tokenPtr) = newPtr; \ } \ @@ -4560,8 +4594,8 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; */ #define TclUtfToUniChar(str, chPtr) \ - (((UCHAR(*(str))) < 0x80) ? \ - ((*(chPtr) = UCHAR(*(str))), 1) \ + (((UCHAR(*(str))) < 0x80) ? \ + ((*(chPtr) = UCHAR(*(str))), 1) \ : Tcl_UtfToUniChar(str, chPtr)) /* @@ -4578,15 +4612,15 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; */ #define TclNumUtfCharsM(numChars, bytes, numBytes) \ - do { \ - Tcl_Size _count, _i = (numBytes); \ - unsigned char *_str = (unsigned char *) (bytes); \ - while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ - _count = (numBytes) - _i; \ - if (_i) { \ - _count += Tcl_NumUtfChars((bytes) + _count, _i); \ - } \ - (numChars) = _count; \ + do { \ + Tcl_Size _count, _i = (numBytes); \ + unsigned char *_str = (unsigned char *) (bytes); \ + while (_i > 0 && (*_str < 0xC0)) { _i--; _str++; } \ + _count = (numBytes) - _i; \ + if (_i) { \ + _count += Tcl_NumUtfChars((bytes) + _count, _i); \ + } \ + (numChars) = _count; \ } while (0); /* @@ -4606,12 +4640,11 @@ MODULE_SCOPE const TclFileAttrProcs tclpFileAttrProcs[]; MODULE_SCOPE int TclIsPureByteArray(Tcl_Obj *objPtr); #define TclIsPureDict(objPtr) \ - (((objPtr)->bytes==NULL) && TclHasInternalRep((objPtr), &tclDictType)) + (((objPtr)->bytes == NULL) && TclHasInternalRep((objPtr), &tclDictType)) #define TclHasInternalRep(objPtr, type) \ - ((objPtr)->typePtr == (type)) + ((objPtr)->typePtr == (type)) #define TclFetchInternalRep(objPtr, type) \ - (TclHasInternalRep((objPtr), (type)) ? &((objPtr)->internalRep) : NULL) - + (TclHasInternalRep((objPtr), (type)) ? &(objPtr)->internalRep : NULL) /* *---------------------------------------------------------------- @@ -4657,7 +4690,6 @@ MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_Init; MODULE_SCOPE Tcl_LibraryInitProc Procbodytest_SafeInit; MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; - /* *---------------------------------------------------------------- * Macro used by the Tcl core to check whether a pattern has any characters @@ -4683,18 +4715,18 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; */ #define TclSetIntObj(objPtr, i) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.wideValue = (Tcl_WideInt) i; \ - TclInvalidateStringRep(objPtr); \ - Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.wideValue = (Tcl_WideInt) i; \ + TclInvalidateStringRep(objPtr); \ + Tcl_StoreInternalRep(objPtr, &tclIntType, &ir); \ } while (0) #define TclSetDoubleObj(objPtr, d) \ - do { \ - Tcl_ObjInternalRep ir; \ - ir.doubleValue = (double) d; \ - TclInvalidateStringRep(objPtr); \ + do { \ + Tcl_ObjInternalRep ir; \ + ir.doubleValue = (double) d; \ + TclInvalidateStringRep(objPtr); \ Tcl_StoreInternalRep(objPtr, &tclDoubleType, &ir); \ } while (0) @@ -4714,58 +4746,58 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; #ifndef TCL_MEM_DEBUG #define TclNewIntObj(objPtr, w) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ - (objPtr)->typePtr = &tclIntType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.wideValue = (Tcl_WideInt)(w); \ + (objPtr)->typePtr = &tclIntType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewUIntObj(objPtr, uw) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) != MP_OKAY) { \ Tcl_Panic("%s: memory overflow", "TclNewUIntObj"); \ - } \ - TclSetBignumInternalRep((objPtr), &bignumValue_); \ - } else { \ + } \ + TclSetBignumInternalRep((objPtr), &bignumValue_); \ + } else { \ (objPtr)->internalRep.wideValue = (Tcl_WideInt)(uw_); \ - (objPtr)->typePtr = &tclIntType; \ - } \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + (objPtr)->typePtr = &tclIntType; \ + } \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewIndexObj(objPtr, w) \ TclNewIntObj(objPtr, w) #define TclNewDoubleObj(objPtr, d) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - (objPtr)->bytes = NULL; \ - (objPtr)->internalRep.doubleValue = (double)(d); \ - (objPtr)->typePtr = &tclDoubleType; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + (objPtr)->bytes = NULL; \ + (objPtr)->internalRep.doubleValue = (double)(d); \ + (objPtr)->typePtr = &tclDoubleType; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #define TclNewStringObj(objPtr, s, len) \ - do { \ - TclIncrObjsAllocated(); \ - TclAllocObjStorage(objPtr); \ - (objPtr)->refCount = 0; \ - TclInitStringRep((objPtr), (s), (len)); \ - (objPtr)->typePtr = NULL; \ - TCL_DTRACE_OBJ_CREATE(objPtr); \ + do { \ + TclIncrObjsAllocated(); \ + TclAllocObjStorage(objPtr); \ + (objPtr)->refCount = 0; \ + TclInitStringRep((objPtr), (s), (len)); \ + (objPtr)->typePtr = NULL; \ + TCL_DTRACE_OBJ_CREATE(objPtr); \ } while (0) #else /* TCL_MEM_DEBUG */ @@ -4773,18 +4805,18 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; (objPtr) = Tcl_NewWideIntObj(w) #define TclNewUIntObj(objPtr, uw) \ - do { \ - Tcl_WideUInt uw_ = (uw); \ - if (uw_ > WIDE_MAX) { \ - mp_int bignumValue_; \ - if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ - (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ - } else { \ - (objPtr) = NULL; \ - } \ - } else { \ - (objPtr) = Tcl_NewWideIntObj(uw_); \ - } \ + do { \ + Tcl_WideUInt uw_ = (uw); \ + if (uw_ > WIDE_MAX) { \ + mp_int bignumValue_; \ + if (mp_init_u64(&bignumValue_, uw_) == MP_OKAY) { \ + (objPtr) = Tcl_NewBignumObj(&bignumValue_); \ + } else { \ + (objPtr) = NULL; \ + } \ + } else { \ + (objPtr) = Tcl_NewWideIntObj(uw_); \ + } \ } while (0) #define TclNewIndexObj(objPtr, w) \ @@ -4836,28 +4868,26 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; * the internal stubs, but the core can use the macro instead. */ -#define TclCleanupCommandMacro(cmdPtr) \ +#define TclCleanupCommandMacro(cmdPtr) \ do { \ if ((cmdPtr)->refCount-- <= 1) { \ Tcl_Free(cmdPtr); \ } \ } while (0) - /* * inside this routine crement refCount first incase cmdPtr is replacing itself */ -#define TclRoutineAssign(location, cmdPtr) \ - do { \ - (cmdPtr)->refCount++; \ - if ((location) != NULL \ - && (location--) <= 1) { \ - Tcl_Free(((location))); \ - } \ - (location) = (cmdPtr); \ +#define TclRoutineAssign(location, cmdPtr) \ + do { \ + (cmdPtr)->refCount++; \ + if ((location) != NULL \ + && (location--) <= 1) { \ + Tcl_Free(((location))); \ + } \ + (location) = (cmdPtr); \ } while (0) - #define TclRoutineHasName(cmdPtr) \ ((cmdPtr)->hPtr != NULL) @@ -4870,9 +4900,10 @@ MODULE_SCOPE Tcl_LibraryInitProc Tcl_ABSListTest_Init; * to the non-inline version. */ -#define TclLimitExceeded(limit) ((limit).exceeded != 0) +#define TclLimitExceeded(limit) \ + ((limit).exceeded != 0) -#define TclLimitReady(limit) \ +#define TclLimitReady(limit) \ (((limit).active == 0) ? 0 : \ (++(limit).granularityTicker, \ ((((limit).active & TCL_LIMIT_COMMANDS) && \ @@ -4990,7 +5021,8 @@ typedef struct NRE_callback { struct NRE_callback *nextPtr; } NRE_callback; -#define TOP_CB(iPtr) (((Interp *)(iPtr))->execEnvPtr->callbackPtr) +#define TOP_CB(iPtr) \ + (((Interp *)(iPtr))->execEnvPtr->callbackPtr) /* * Inline version of Tcl_NRAddCallback. @@ -5029,9 +5061,9 @@ typedef struct NRE_callback { #include "tclIntPlatDecls.h" #if !defined(USE_TCL_STUBS) && !defined(TCL_MEM_DEBUG) -#define Tcl_AttemptAlloc TclpAlloc -#define Tcl_AttemptRealloc TclpRealloc -#define Tcl_Free TclpFree +#define Tcl_AttemptAlloc TclpAlloc +#define Tcl_AttemptRealloc TclpRealloc +#define Tcl_Free TclpFree #endif /* diff --git a/generic/tclInterp.c b/generic/tclInterp.c index b2d883b..5fbefbf 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -186,7 +186,7 @@ struct LimitHandler { int flags; /* The state of this particular handler. */ Tcl_LimitHandlerProc *handlerProc; /* The handler callback. */ - void *clientData; /* Opaque argument to the handler callback. */ + void *clientData; /* Opaque argument to the handler callback. */ Tcl_LimitHandlerDeleteProc *deleteProc; /* How to delete the clientData. */ LimitHandler *prevPtr; /* Previous item in linked list of @@ -207,8 +207,6 @@ struct LimitHandler { #define LIMIT_HANDLER_ACTIVE 0x01 #define LIMIT_HANDLER_DELETED 0x02 - - /* * Prototypes for local static functions: */ @@ -277,7 +275,6 @@ static void TimeLimitCallback(void *clientData); static Tcl_NRPostProc NRPostInvokeHidden; static Tcl_ObjCmdProc NRInterpCmd; static Tcl_ObjCmdProc NRChildCmd; - /* *---------------------------------------------------------------------- diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 2d925e7..1bb3587 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -1616,8 +1616,7 @@ Tcl_Obj * TclListObjGetElement( Tcl_Obj *objPtr, /* List object for which an element array is * to be returned. */ - Tcl_Size index -) + Tcl_Size index) { return ListObjStorePtr(objPtr)->slots[ListObjStart(objPtr) + index]; } @@ -2018,7 +2017,6 @@ Tcl_ListObjLength( return TCL_OK; } - if (TclListObjGetRep(interp, listObj, &listRep) != TCL_OK) { return TCL_ERROR; } @@ -3552,7 +3550,6 @@ UpdateStringOfList( Tcl_Free(flagPtr); } } - /* *------------------------------------------------------------------------ diff --git a/generic/tclLoad.c b/generic/tclLoad.c index d7c13d1..c5a181d 100644 --- a/generic/tclLoad.c +++ b/generic/tclLoad.c @@ -12,7 +12,6 @@ #include "tclInt.h" - /* * The following structure describes a library that has been loaded either * dynamically (with the "load" command) or statically (as indicated by a call @@ -96,7 +95,6 @@ static int IsStatic(LoadedLibrary *libraryPtr); static int UnloadLibrary(Tcl_Interp *interp, Tcl_Interp *target, LoadedLibrary *library, int keepLibrary, const char *fullFileName, int interpExiting); - static int IsStatic( @@ -144,7 +142,7 @@ Tcl_LoadObjCmd( int flags = 0; Tcl_Obj *const *savedobjv = objv; static const char *const options[] = { - "-global", "-lazy", "--", NULL + "-global", "-lazy", "--", NULL }; enum loadOptionsEnum { LOAD_GLOBAL, LOAD_LAZY, LOAD_LAST @@ -168,7 +166,8 @@ Tcl_LoadObjCmd( } } if ((objc < 2) || (objc > 4)) { - Tcl_WrongNumArgs(interp, 1, savedobjv, "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"); + Tcl_WrongNumArgs(interp, 1, savedobjv, + "?-global? ?-lazy? ?--? fileName ?prefix? ?interp?"); return TCL_ERROR; } if (Tcl_FSConvertToPathType(interp, objv[1]) != TCL_OK) { @@ -753,7 +752,6 @@ Tcl_UnloadObjCmd( } return code; } - /* *---------------------------------------------------------------------- @@ -773,13 +771,12 @@ Tcl_UnloadObjCmd( */ static int UnloadLibrary( - Tcl_Interp *interp, - Tcl_Interp *target, - LoadedLibrary *libraryPtr, - int keepLibrary, - const char *fullFileName, - int interpExiting -) + Tcl_Interp *interp, + Tcl_Interp *target, + LoadedLibrary *libraryPtr, + int keepLibrary, + const char *fullFileName, + int interpExiting) { int code; InterpLibrary *ipFirstPtr, *ipPtr; @@ -821,8 +818,6 @@ UnloadLibrary( unloadProc = libraryPtr->unloadProc; } - - /* * We are ready to unload the library. First, evaluate the unload * function. If this fails, we cannot proceed with unload. Also, we must @@ -856,13 +851,11 @@ UnloadLibrary( code = unloadProc(target, code); } - if (code != TCL_OK) { Tcl_TransferResult(target, code, interp); goto done; } - /* * Remove this library from the interpreter's library cache. */ @@ -885,7 +878,6 @@ UnloadLibrary( Tcl_Free(ipPtr); Tcl_SetAssocData(target, "tclLoad", LoadCleanupProc, ipFirstPtr); - if (IsStatic(libraryPtr)) { goto done; } @@ -1107,9 +1099,8 @@ TclGetLoadedLibraries( * NULL, return info about all interps; * otherwise, just return info about this * interpreter. */ - const char *prefix) /* Prefix or NULL. If NULL, return info - * for all prefixes. - */ + const char *prefix) /* Prefix or NULL. If NULL, return info + * for all prefixes. */ { Tcl_Interp *target; LoadedLibrary *libraryPtr; diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 2a30742..eebf6aa 100644 --- a/generic/tclNamesp.c +++ b/generic/tclNamesp.c @@ -1079,8 +1079,7 @@ TclNamespaceDeleted( void TclDeleteNamespaceChildren( - Namespace *nsPtr /* Namespace whose children to delete */ -) + Namespace *nsPtr) /* Namespace whose children to delete */ { Interp *iPtr = (Interp *) nsPtr->interp; Tcl_HashEntry *entryPtr; @@ -3962,7 +3961,6 @@ NamespaceOriginCmd( Tcl_SetObjResult(interp, resultPtr); return TCL_OK; } - /* *---------------------------------------------------------------------- @@ -5156,7 +5154,6 @@ Tcl_LogCommandInfo( { TclLogCommandInfo(interp, script, command, length, NULL, NULL); } - /* * Local Variables: diff --git a/generic/tclOOCall.c b/generic/tclOOCall.c index 7695483..a65ce5e 100644 --- a/generic/tclOOCall.c +++ b/generic/tclOOCall.c @@ -155,7 +155,6 @@ static const Tcl_ObjType methodNameType = { NULL, TCL_OBJTYPE_V0 }; - /* * ---------------------------------------------------------------------- @@ -931,6 +930,9 @@ AddSimpleChainToCallContext( } } } + if (!oPtr->selfCls) { + return foundPrivate; + } if (contextCls) { foundPrivate |= AddPrivatesFromClassChainToCallContext(oPtr->selfCls, contextCls, methodNameObj, cbPtr, doneFilters, flags, @@ -1074,15 +1076,28 @@ InitCallChain( Object *oPtr, int flags) { + /* + * Note that it's possible to end up with a NULL oPtr->selfCls here if + * there is a call into stereotypical object after it has finished running + * its destructor phase. Such things can't be cached for a long time so the + * epoch can be bogus. [Bug 7842f33a5c] + */ + callPtr->flags = flags & (PUBLIC_METHOD | PRIVATE_METHOD | SPECIAL | FILTER_HANDLING); if (oPtr->flags & USE_CLASS_CACHE) { - oPtr = oPtr->selfCls->thisPtr; + oPtr = (oPtr->selfCls ? oPtr->selfCls->thisPtr : NULL); callPtr->flags |= USE_CLASS_CACHE; } - callPtr->epoch = oPtr->fPtr->epoch; - callPtr->objectCreationEpoch = oPtr->creationEpoch; - callPtr->objectEpoch = oPtr->epoch; + if (oPtr) { + callPtr->epoch = oPtr->fPtr->epoch; + callPtr->objectCreationEpoch = oPtr->creationEpoch; + callPtr->objectEpoch = oPtr->epoch; + } else { + callPtr->epoch = 0; + callPtr->objectCreationEpoch = 0; + callPtr->objectEpoch = 0; + } callPtr->refCount = 1; callPtr->numChain = 0; callPtr->chain = callPtr->staticChain; @@ -1113,6 +1128,13 @@ IsStillValid( int mask) { if ((oPtr->flags & USE_CLASS_CACHE)) { + /* + * If the object is in a weird state (due to stereotype tricks) then + * just declare the cache invalid. [Bug 7842f33a5c] + */ + if (!oPtr->selfCls) { + return 0; + } oPtr = oPtr->selfCls->thisPtr; flags |= USE_CLASS_CACHE; } @@ -1210,8 +1232,16 @@ TclOOGetCallContext( Tcl_StoreInternalRep(cacheInThisObj, &methodNameType, NULL); } - if (oPtr->flags & USE_CLASS_CACHE) { - if (oPtr->selfCls->classChainCache != NULL) { + /* + * Note that it's possible to end up with a NULL oPtr->selfCls here if + * there is a call into stereotypical object after it has finished + * running its destructor phase. It's quite a tangle, but at that + * point, we simply can't get stereotypes from the cache. + * [Bug 7842f33a5c] + */ + + if (oPtr->flags & USE_CLASS_CACHE && oPtr->selfCls) { + if (oPtr->selfCls->classChainCache) { hPtr = Tcl_FindHashEntry(oPtr->selfCls->classChainCache, methodNameObj); } else { @@ -1425,6 +1455,17 @@ TclOOGetStereotypeCallChain( Object obj; /* + * Note that it's possible to end up with a NULL clsPtr here if there is + * a call into stereotypical object after it has finished running its + * destructor phase. It's quite a tangle, but at that point, we simply + * can't get stereotypes. [Bug 7842f33a5c] + */ + + if (clsPtr == NULL) { + return NULL; + } + + /* * Synthesize a temporary stereotypical object so that we can use existing * machinery to produce the stereotypical call chain. */ @@ -1651,9 +1692,16 @@ AddPrivatesFromClassChainToCallContext( * * Note that mixins must be processed before the main class hierarchy. * [Bug 1998221] + * + * Note also that it's possible to end up with a null classPtr here if + * there is a call into stereotypical object after it has finished running + * its destructor phase. [Bug 7842f33a5c] */ tailRecurse: + if (classPtr == NULL) { + return 0; + } FOREACH(superPtr, classPtr->mixins) { if (AddPrivatesFromClassChainToCallContext(superPtr, contextCls, methodName, cbPtr, doneFilters, flags|TRAVERSED_MIXIN, @@ -1733,6 +1781,9 @@ AddSimpleClassChainToCallContext( */ tailRecurse: + if (classPtr == NULL) { + return privateDanger; + } FOREACH(superPtr, classPtr->mixins) { privateDanger |= AddSimpleClassChainToCallContext(superPtr, methodNameObj, cbPtr, doneFilters, flags | TRAVERSED_MIXIN, diff --git a/generic/tclOOInfo.c b/generic/tclOOInfo.c index 0b9099e..7435fff 100644 --- a/generic/tclOOInfo.c +++ b/generic/tclOOInfo.c @@ -621,9 +621,22 @@ InfoObjectMethodsCmd( Tcl_Free((void *)names); } } else if (oPtr->methodsPtr) { - FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { - if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { - Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + if (scope == -1) { + /* + * Handle legacy-mode matching. [Bug 36e5517a6850] + */ + int scopeFilter = flag | TRUE_PRIVATE_METHOD; + + FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { + if (mPtr->typePtr && (mPtr->flags & scopeFilter) == flag) { + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + } + } + } else { + FOREACH_HASH(namePtr, mPtr, oPtr->methodsPtr) { + if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + } } } } @@ -1378,9 +1391,22 @@ InfoClassMethodsCmd( } else { FOREACH_HASH_DECLS; - FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { - if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { - Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + if (scope == -1) { + /* + * Handle legacy-mode matching. [Bug 36e5517a6850] + */ + int scopeFilter = flag | TRUE_PRIVATE_METHOD; + + FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { + if (mPtr->typePtr && (mPtr->flags & scopeFilter) == flag) { + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + } + } + } else { + FOREACH_HASH(namePtr, mPtr, &clsPtr->classMethods) { + if (mPtr->typePtr && (mPtr->flags & SCOPE_FLAGS) == flag) { + Tcl_ListObjAppendElement(NULL, resultObj, namePtr); + } } } } diff --git a/generic/tclOOInt.h b/generic/tclOOInt.h index 031b910..5700b16 100644 --- a/generic/tclOOInt.h +++ b/generic/tclOOInt.h @@ -97,6 +97,16 @@ typedef struct ProcedureMethod { GetFrameInfoValueProc *gfivProc; /* Callback to allow for fine tuning of how * the method reports itself. */ + Command cmd; /* Space used to connect to [info frame] */ + ExtraFrameInfo efi; /* Space used to store data for [info frame] */ + Tcl_Interp *interp; /* Interpreter in which to compute the name of + * the method. */ + Tcl_Method method; /* Method to compute the name of. */ + int callSiteFlags; /* Flags from the call chain. Only interested + * in whether this is a constructor or + * destructor, which we can't know until then + * for messy reasons. Other flags are variable + * but not used. */ } ProcedureMethod; #define TCLOO_PROCEDURE_METHOD_VERSION 0 diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index be51f0b..c5bed43 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -17,17 +17,6 @@ #include "tclCompile.h" /* - * Structure used to help delay computing names of objects or classes for - * [info frame] until needed, making invocation faster in the normal case. - */ - -struct PNI { - Tcl_Interp *interp; /* Interpreter in which to compute the name of - * a method. */ - Tcl_Method method; /* Method to compute the name of. */ -}; - -/* * Structure used to contain all the information needed about a call frame * used in a procedure-like method. */ @@ -36,13 +25,8 @@ typedef struct { CallFrame *framePtr; /* Reference to the call frame itself (it's * actually allocated on the Tcl stack). */ ProcErrorProc *errProc; /* The error handler for the body. */ - Tcl_Obj *nameObj; /* The "name" of the command. */ - Command cmd; /* The command structure. Mostly bogus. */ - ExtraFrameInfo efi; /* Extra information used for [info frame]. */ - Command *oldCmdPtr; /* Saved cmdPtr so that we can be safe after a - * recursive call returns. */ - struct PNI pni; /* Specialist information used in the efi - * field for this type of call. */ + Tcl_Obj *nameObj; /* The "name" of the command. Only used for a + * few moments, so not reference. */ } PMFrameData; /* @@ -83,6 +67,7 @@ static int CloneProcedureMethod(Tcl_Interp *interp, static ProcErrorProc MethodErrorHandler; static ProcErrorProc ConstructorErrorHandler; static ProcErrorProc DestructorErrorHandler; +static Tcl_Obj * RenderMethodName(void *clientData); static Tcl_Obj * RenderDeclarerName(void *clientData); static int InvokeForwardMethod(void *clientData, Tcl_Interp *interp, Tcl_ObjectContext context, @@ -114,6 +99,20 @@ static const Tcl_MethodType fwdMethodType = { ((Tcl_HashTable *) (&((Namespace *) (contextNs))->varTable)) #define TclVarHashGetValue(hPtr) \ ((Tcl_Var) ((char *)hPtr - offsetof(VarInHash, entry))) + +static inline ProcedureMethod * +AllocProcedureMethodRecord( + int flags) +{ + ProcedureMethod *pmPtr = (ProcedureMethod *) + Tcl_Alloc(sizeof(ProcedureMethod)); + memset(pmPtr, 0, sizeof(ProcedureMethod)); + pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; + pmPtr->flags = flags & USE_DECLARER_NS; + pmPtr->refCount = 1; + pmPtr->cmd.clientData = &pmPtr->efi; + return pmPtr; +} /* * ---------------------------------------------------------------------- @@ -428,12 +427,7 @@ TclOONewProcInstanceMethod( if (TclListObjLength(interp, argsObj, &argsLen) != TCL_OK) { return NULL; } - pmPtr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod)); - memset(pmPtr, 0, sizeof(ProcedureMethod)); - pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; - pmPtr->flags = flags & USE_DECLARER_NS; - pmPtr->refCount = 1; - + pmPtr = AllocProcedureMethodRecord(flags); method = TclOOMakeProcInstanceMethod(interp, oPtr, flags, nameObj, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); if (method == NULL) { @@ -489,12 +483,7 @@ TclOONewProcMethod( procName = (nameObj==NULL ? "<constructor>" : TclGetString(nameObj)); } - pmPtr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod)); - memset(pmPtr, 0, sizeof(ProcedureMethod)); - pmPtr->version = TCLOO_PROCEDURE_METHOD_VERSION; - pmPtr->flags = flags & USE_DECLARER_NS; - pmPtr->refCount = 1; - + pmPtr = AllocProcedureMethodRecord(flags); method = TclOOMakeProcMethod(interp, clsPtr, flags, nameObj, procName, argsObj, bodyObj, &procMethodType, pmPtr, &pmPtr->procPtr); @@ -768,6 +757,37 @@ InvokeProcedureMethod( } /* + * Finishes filling out the extra frame info so that [info frame] works if + * that is not already set up. + */ + + if (pmPtr->efi.length == 0) { + Tcl_Method method = Tcl_ObjectContextMethod(context); + + pmPtr->efi.length = 2; + pmPtr->efi.fields[0].name = "method"; + pmPtr->efi.fields[0].proc = RenderMethodName; + pmPtr->efi.fields[0].clientData = pmPtr; + pmPtr->callSiteFlags = ((CallContext *) + context)->callPtr->flags & (CONSTRUCTOR | DESTRUCTOR); + pmPtr->interp = interp; + pmPtr->method = method; + if (pmPtr->gfivProc != NULL) { + pmPtr->efi.fields[1].name = ""; + pmPtr->efi.fields[1].proc = pmPtr->gfivProc; + pmPtr->efi.fields[1].clientData = pmPtr; + } else { + if (Tcl_MethodDeclarerObject(method) != NULL) { + pmPtr->efi.fields[1].name = "object"; + } else { + pmPtr->efi.fields[1].name = "class"; + } + pmPtr->efi.fields[1].proc = RenderDeclarerName; + pmPtr->efi.fields[1].clientData = pmPtr; + } + } + + /* * Allocate the special frame data. */ @@ -796,13 +816,6 @@ InvokeProcedureMethod( result = pmPtr->preCallProc(pmPtr->clientData, interp, context, (Tcl_CallFrame *) fdPtr->framePtr, &isFinished); if (isFinished || result != TCL_OK) { - /* - * Restore the old cmdPtr so that a subsequent use of [info frame] - * won't crash on us. [Bug 3001438] - */ - - pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; - Tcl_PopCallFrame(interp); TclStackFree(interp, fdPtr->framePtr); if (pmPtr->refCount-- <= 1) { @@ -844,13 +857,6 @@ FinalizePMCall( } /* - * Restore the old cmdPtr so that a subsequent use of [info frame] won't - * crash on us. [Bug 3001438] - */ - - pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; - - /* * Scrap the special frame data now that we're done with it. Note that we * are inlining DeleteProcedureMethod() here; this location is highly * sensitive when it comes to performance! @@ -876,7 +882,6 @@ PushMethodCallFrame( { Namespace *nsPtr = (Namespace *) contextPtr->oPtr->namespacePtr; int result; - const char *namePtr; CallFrame **framePtrPtr = &fdPtr->framePtr; ByteCode *codePtr; @@ -885,17 +890,14 @@ PushMethodCallFrame( */ if (contextPtr->callPtr->flags & CONSTRUCTOR) { - namePtr = "<constructor>"; fdPtr->nameObj = contextPtr->oPtr->fPtr->constructorName; fdPtr->errProc = ConstructorErrorHandler; } else if (contextPtr->callPtr->flags & DESTRUCTOR) { - namePtr = "<destructor>"; fdPtr->nameObj = contextPtr->oPtr->fPtr->destructorName; fdPtr->errProc = DestructorErrorHandler; } else { fdPtr->nameObj = Tcl_MethodName( Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr)); - namePtr = TclGetString(fdPtr->nameObj); fdPtr->errProc = MethodErrorHandler; } if (pmPtr->errProc != NULL) { @@ -908,8 +910,7 @@ PushMethodCallFrame( */ if (pmPtr->flags & USE_DECLARER_NS) { - Method *mPtr = - contextPtr->callPtr->chain[contextPtr->index].mPtr; + Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr; if (mPtr->declaringClassPtr != NULL) { nsPtr = (Namespace *) @@ -920,43 +921,29 @@ PushMethodCallFrame( } /* - * Save the old cmdPtr so that when this recursive call returns, we can - * restore it. To do otherwise causes crashes in [info frame] after we - * return from a recursive call. [Bug 3001438] - */ - - fdPtr->oldCmdPtr = pmPtr->procPtr->cmdPtr; - - /* - * Compile the body. This operation may fail. - */ - - fdPtr->efi.length = 2; - memset(&fdPtr->cmd, 0, sizeof(Command)); - fdPtr->cmd.nsPtr = nsPtr; - fdPtr->cmd.clientData = &fdPtr->efi; - pmPtr->procPtr->cmdPtr = &fdPtr->cmd; - - /* + * Compile the body. + * * [Bug 2037727] Always call TclProcCompileProc so that we check not only * that we have bytecode, but also that it remains valid. Note that we set * the namespace of the code here directly; this is a hack, but the * alternative is *so* slow... */ + pmPtr->procPtr->cmdPtr = &pmPtr->cmd; ByteCodeGetInternalRep(pmPtr->procPtr->bodyPtr, &tclByteCodeType, codePtr); if (codePtr) { codePtr->nsPtr = nsPtr; } result = TclProcCompileProc(interp, pmPtr->procPtr, - pmPtr->procPtr->bodyPtr, nsPtr, "body of method", namePtr); + pmPtr->procPtr->bodyPtr, nsPtr, "body of method", + TclGetString(fdPtr->nameObj)); if (result != TCL_OK) { - goto failureReturn; + return result; } /* * Make the stack frame and fill it out with information about this call. - * This operation may fail. + * This operation doesn't ever actually fail. */ (void) TclPushStackFrame(interp, (Tcl_CallFrame **) framePtrPtr, @@ -967,42 +954,7 @@ PushMethodCallFrame( fdPtr->framePtr->objv = objv; fdPtr->framePtr->procPtr = pmPtr->procPtr; - /* - * Finish filling out the extra frame info so that [info frame] works. - */ - - fdPtr->efi.fields[0].name = "method"; - fdPtr->efi.fields[0].proc = NULL; - fdPtr->efi.fields[0].clientData = fdPtr->nameObj; - if (pmPtr->gfivProc != NULL) { - fdPtr->efi.fields[1].name = ""; - fdPtr->efi.fields[1].proc = pmPtr->gfivProc; - fdPtr->efi.fields[1].clientData = pmPtr; - } else { - Tcl_Method method = - Tcl_ObjectContextMethod((Tcl_ObjectContext) contextPtr); - - if (Tcl_MethodDeclarerObject(method) != NULL) { - fdPtr->efi.fields[1].name = "object"; - } else { - fdPtr->efi.fields[1].name = "class"; - } - fdPtr->efi.fields[1].proc = RenderDeclarerName; - fdPtr->efi.fields[1].clientData = &fdPtr->pni; - fdPtr->pni.interp = interp; - fdPtr->pni.method = method; - } - return TCL_OK; - - /* - * Restore the old cmdPtr so that a subsequent use of [info frame] won't - * crash on us. [Bug 3001438] - */ - - failureReturn: - pmPtr->procPtr->cmdPtr = fdPtr->oldCmdPtr; - return result; } /* @@ -1218,6 +1170,32 @@ ProcedureMethodCompiledVarResolver( /* * ---------------------------------------------------------------------- * + * RenderMethodName -- + * + * Returns the name of the declared method. Used for producing information + * for [info frame]. + * + * ---------------------------------------------------------------------- + */ + +static Tcl_Obj * +RenderMethodName( + void *clientData) +{ + ProcedureMethod *pmPtr = (ProcedureMethod *) clientData; + + if (pmPtr->callSiteFlags & CONSTRUCTOR) { + return TclOOGetFoundation(pmPtr->interp)->constructorName; + } else if (pmPtr->callSiteFlags & DESTRUCTOR) { + return TclOOGetFoundation(pmPtr->interp)->destructorName; + } else { + return Tcl_MethodName(pmPtr->method); + } +} + +/* + * ---------------------------------------------------------------------- + * * RenderDeclarerName -- * * Returns the name of the entity (object or class) which declared a @@ -1232,13 +1210,13 @@ static Tcl_Obj * RenderDeclarerName( void *clientData) { - struct PNI *pni = (struct PNI *)clientData; - Tcl_Object object = Tcl_MethodDeclarerObject(pni->method); + ProcedureMethod *pmPtr = (ProcedureMethod *) clientData; + Tcl_Object object = Tcl_MethodDeclarerObject(pmPtr->method); if (object == NULL) { - object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pni->method)); + object = Tcl_GetClassAsObject(Tcl_MethodDeclarerClass(pmPtr->method)); } - return TclOOObjectName(pni->interp, (Object *) object); + return TclOOObjectName(pmPtr->interp, (Object *) object); } /* @@ -1434,6 +1412,8 @@ CloneProcedureMethod( pm2Ptr = (ProcedureMethod *)Tcl_Alloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; + pm2Ptr->cmd.clientData = &pm2Ptr->efi; + pm2Ptr->efi.length = 0; /* Trigger a reinit of this. */ Tcl_IncrRefCount(argsObj); Tcl_IncrRefCount(bodyObj); if (TclCreateProc(interp, NULL, "", argsObj, bodyObj, diff --git a/generic/tclObj.c b/generic/tclObj.c index 30634a0..36856d4 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -349,7 +349,6 @@ typedef struct ResolvedCmdName { #define FREEDREFCOUNTFILLER \ (Tcl_Size)(sizeof(objPtr->refCount) == 4 ? 0xe8e8e8e8 : 0xe8e8e8e8e8e8e8e8) #endif - /* *------------------------------------------------------------------------- @@ -2568,7 +2567,6 @@ Tcl_GetIntFromObj( return TCL_OK; #endif } - /* *---------------------------------------------------------------------- diff --git a/generic/tclPanic.c b/generic/tclPanic.c index dcceb25..ed12640 100644 --- a/generic/tclPanic.c +++ b/generic/tclPanic.c @@ -81,7 +81,6 @@ Tcl_Panic( * to pass to fprintf. */ char *arg4, *arg5, *arg6, *arg7, *arg8; - va_start(argList, format); arg1 = va_arg(argList, char *); arg2 = va_arg(argList, char *); diff --git a/generic/tclParse.c b/generic/tclParse.c index 13e5c1e..e88de0b 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -1396,7 +1396,7 @@ Tcl_ParseVarName( case '}': braceCount--; break; case '\\': /* if 2 or more left, consume 2, else consume - just the \ and let it run into the end */ + * just the \ and let it run into the end */ if (numBytes > 1) { src++; numBytes--; } diff --git a/generic/tclPathObj.c b/generic/tclPathObj.c index 80954bc..9a44863 100644 --- a/generic/tclPathObj.c +++ b/generic/tclPathObj.c @@ -1519,7 +1519,6 @@ Tcl_FSNewNativePath( Tcl_Obj *pathPtr = NULL; FsPath *fsPathPtr; - if (fromFilesystem->internalToNormalizedProc != NULL) { pathPtr = (*fromFilesystem->internalToNormalizedProc)(clientData); } @@ -2689,7 +2688,6 @@ TclResolveTildePathList( return resolvedPaths; } - /* * Local Variables: diff --git a/generic/tclProc.c b/generic/tclProc.c index 40c6f32..2f87048 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -69,7 +69,7 @@ const Tcl_ObjType tclProcBodyType = { TCL_OBJTYPE_V0 }; -#define ProcSetInternalRep(objPtr, procPtr) \ +#define ProcSetInternalRep(objPtr, procPtr) \ do { \ Tcl_ObjInternalRep ir; \ (procPtr)->refCount++; \ @@ -78,11 +78,11 @@ const Tcl_ObjType tclProcBodyType = { Tcl_StoreInternalRep((objPtr), &tclProcBodyType, &ir); \ } while (0) -#define ProcGetInternalRep(objPtr, procPtr) \ +#define ProcGetInternalRep(objPtr, procPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &tclProcBodyType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) /* @@ -116,23 +116,22 @@ static const Tcl_ObjType lambdaType = { TCL_OBJTYPE_V0 }; -#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaSetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ Tcl_ObjInternalRep ir; \ ir.twoPtrValue.ptr1 = (procPtr); \ ir.twoPtrValue.ptr2 = (nsObjPtr); \ Tcl_IncrRefCount((nsObjPtr)); \ - Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ + Tcl_StoreInternalRep((objPtr), &lambdaType, &ir); \ } while (0) -#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ +#define LambdaGetInternalRep(objPtr, procPtr, nsObjPtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ - irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ - (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ - (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ + const Tcl_ObjInternalRep *irPtr; \ + irPtr = TclFetchInternalRep((objPtr), &lambdaType); \ + (procPtr) = irPtr ? (Proc *)irPtr->twoPtrValue.ptr1 : NULL; \ + (nsObjPtr) = irPtr ? (Tcl_Obj *)irPtr->twoPtrValue.ptr2 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- @@ -156,7 +155,7 @@ int Tcl_ProcObjCmd( TCL_UNUSED(void *), Tcl_Interp *interp, /* Current interpreter. */ - Tcl_Size objc, /* Number of arguments. */ + Tcl_Size objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { Interp *iPtr = (Interp *) interp; @@ -1095,7 +1094,8 @@ ProcWrongNumArgs( if (defPtr->value.objPtr != NULL) { TclNewObj(argObj); - Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", (void *)NULL); + Tcl_AppendStringsToObj(argObj, "?", TclGetString(namePtr), "?", + (void *)NULL); } else if (defPtr->flags & VAR_IS_ARGS) { numArgs--; final = "?arg ...?"; @@ -1339,7 +1339,7 @@ InitLocalCache( static int InitArgsAndLocals( - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ int skip) /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ @@ -1503,9 +1503,9 @@ InitArgsAndLocals( int TclPushProcCallFrame( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ Tcl_Size objc, /* Count of number of arguments to this * procedure. */ @@ -1597,9 +1597,9 @@ TclPushProcCallFrame( int TclObjInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ int objc, /* Count of number of arguments to this * procedure. */ @@ -1614,11 +1614,11 @@ TclObjInterpProc( int TclNRInterpProc( - void *clientData, /* Record describing procedure to be + void *clientData, /* Record describing procedure to be * interpreted. */ - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - Tcl_Size objc, /* Count of number of arguments to this + Tcl_Size objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1637,7 +1637,7 @@ NRInterpProc( * interpreted. */ Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ - int objc, /* Count of number of arguments to this + int objc, /* Count of number of arguments to this * procedure. */ Tcl_Obj *const objv[]) /* Argument value objects. */ { @@ -1666,7 +1666,6 @@ ObjInterpProc2( return Tcl_NRCallObjProc2(interp, TclNRInterpProc, clientData, objc, objv); } - /* *---------------------------------------------------------------------- @@ -1688,10 +1687,10 @@ ObjInterpProc2( int TclNRInterpProcCore( - Tcl_Interp *interp,/* Interpreter in which procedure was + Tcl_Interp *interp, /* Interpreter in which procedure was * invoked. */ Tcl_Obj *procNameObj, /* Procedure name for error reporting. */ - Tcl_Size skip, /* Number of initial arguments to be skipped, + Tcl_Size skip, /* Number of initial arguments to be skipped, * i.e., words in the "command name". */ ProcErrorProc *errorProc) /* How to convert results from the script into * results of the overall procedure. */ @@ -2137,7 +2136,7 @@ TclProcDeleteProc( void TclProcCleanupProc( - Proc *procPtr) /* Procedure to be deleted. */ + Proc *procPtr) /* Procedure to be deleted. */ { CompiledLocal *localPtr; Tcl_Obj *bodyPtr = procPtr->bodyPtr; @@ -2402,7 +2401,7 @@ ProcBodyFree( static void DupLambdaInternalRep( Tcl_Obj *srcPtr, /* Object with internal rep to copy. */ - Tcl_Obj *copyPtr) /* Object with internal rep to set. */ + Tcl_Obj *copyPtr) /* Object with internal rep to set. */ { Proc *procPtr; Tcl_Obj *nsObjPtr; @@ -2417,7 +2416,7 @@ DupLambdaInternalRep( static void FreeLambdaInternalRep( - Tcl_Obj *objPtr) /* CmdName object with internal representation + Tcl_Obj *objPtr) /* CmdName object with internal representation * to free. */ { Proc *procPtr; @@ -2435,7 +2434,7 @@ FreeLambdaInternalRep( static int SetLambdaFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ - Tcl_Obj *objPtr) /* The object to convert. */ + Tcl_Obj *objPtr) /* The object to convert. */ { Interp *iPtr = (Interp *) interp; const char *name; diff --git a/generic/tclProcess.c b/generic/tclProcess.c index 968e191..a5607d9 100644 --- a/generic/tclProcess.c +++ b/generic/tclProcess.c @@ -350,7 +350,6 @@ WaitProcessStatus( } } - /* *---------------------------------------------------------------------- * @@ -891,8 +890,7 @@ TclProcessWait( * - errno in case of error. * - non-zero exit code for abormal exit. * - signal number if killed or suspended. - * - Tcl_WaitPid status in all other cases. - */ + * - Tcl_WaitPid status in all other cases. */ Tcl_Obj **msgObjPtr, /* If non-NULL, will receive error message. */ Tcl_Obj **errorObjPtr) /* If non-NULL, will receive error code. */ { diff --git a/generic/tclRegexp.c b/generic/tclRegexp.c index bc6468d..04f060b 100644 --- a/generic/tclRegexp.c +++ b/generic/tclRegexp.c @@ -111,22 +111,21 @@ const Tcl_ObjType tclRegexpType = { TCL_OBJTYPE_V0 }; -#define RegexpSetInternalRep(objPtr, rePtr) \ +#define RegexpSetInternalRep(objPtr, rePtr) \ do { \ Tcl_ObjInternalRep ir; \ (rePtr)->refCount++; \ ir.twoPtrValue.ptr1 = (rePtr); \ ir.twoPtrValue.ptr2 = NULL; \ - Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ + Tcl_StoreInternalRep((objPtr), &tclRegexpType, &ir); \ } while (0) -#define RegexpGetInternalRep(objPtr, rePtr) \ +#define RegexpGetInternalRep(objPtr, rePtr) \ do { \ - const Tcl_ObjInternalRep *irPtr; \ + const Tcl_ObjInternalRep *irPtr; \ irPtr = TclFetchInternalRep((objPtr), &tclRegexpType); \ - (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ + (rePtr) = irPtr ? (TclRegexp *)irPtr->twoPtrValue.ptr1 : NULL; \ } while (0) - /* *---------------------------------------------------------------------- @@ -223,8 +222,8 @@ Tcl_RegExpExec( Tcl_DStringInit(&ds); ustr = Tcl_UtfToUniCharDString(text, TCL_INDEX_NONE, &ds); numChars = Tcl_DStringLength(&ds) / sizeof(Tcl_UniChar); - result = RegExpExecUniChar(interp, re, ustr, numChars, TCL_INDEX_NONE /* nmatches */, - flags); + result = RegExpExecUniChar(interp, re, ustr, numChars, + TCL_INDEX_NONE /* nmatches */, flags); Tcl_DStringFree(&ds); return result; @@ -306,7 +305,7 @@ RegExpExecUniChar( * previous call to Tcl_GetRegExpFromObj */ const Tcl_UniChar *wString, /* String against which to match re. */ size_t numChars, /* Length of Tcl_UniChar string. */ - size_t nm, /* How many subexpression matches (counting + size_t nm, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means "don't know". */ int flags) /* Regular expression flags. */ @@ -367,9 +366,9 @@ TclRegExpRangeUniChar( * > 0 means give the range of a matching * subrange, -1 means the range of the * rm_extend field. */ - Tcl_Size *startPtr, /* Store address of first character in + Tcl_Size *startPtr, /* Store address of first character in * (sub-)range here. */ - Tcl_Size *endPtr) /* Store address of character just after last + Tcl_Size *endPtr) /* Store address of character just after last * in (sub-)range here. */ { TclRegexp *regexpPtr = (TclRegexp *) re; @@ -445,7 +444,7 @@ Tcl_RegExpExecObj( Tcl_Obj *textObj, /* Text against which to match re. */ Tcl_Size offset, /* Character index that marks where matching * should begin. */ - Tcl_Size nmatches, /* How many subexpression matches (counting + Tcl_Size nmatches, /* How many subexpression matches (counting * the whole match as subexpression 0) are of * interest. -1 means all of them. */ int flags) /* Regular expression execution flags. */ @@ -859,7 +858,7 @@ static TclRegexp * CompileRegexp( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ const char *string, /* The regexp to compile (UTF-8). */ - size_t length, /* The length of the string in bytes. */ + size_t length, /* The length of the string in bytes. */ int flags) /* Compilation flags. */ { TclRegexp *regexpPtr; diff --git a/generic/tclStrIdxTree.c b/generic/tclStrIdxTree.c index 21be447..07accc2 100644 --- a/generic/tclStrIdxTree.c +++ b/generic/tclStrIdxTree.c @@ -486,16 +486,15 @@ TclStrIdxTreePrint( int TclStrIdxTreeTestObjCmd( - ClientData clientData, Tcl_Interp *interp, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { const char *cs, *cin, *ret; static const char *const options[] = { - "index", "puts-index", "findequal", - NULL + "findequal", "index", "puts-index", NULL }; enum optionInd { - O_INDEX, O_PUTS_INDEX, O_FINDEQUAL + O_FINDEQUAL, O_INDEX, O_PUTS_INDEX }; int optionIndex; diff --git a/generic/tclStrToD.c b/generic/tclStrToD.c index 87aab60..1b78184 100644 --- a/generic/tclStrToD.c +++ b/generic/tclStrToD.c @@ -26,7 +26,6 @@ # define PRIx64 TCL_LL_MODIFIER "x" #endif - /* * This code supports (at least hypothetically), IBM, Cray, VAX and IEEE-754 * floating point; of these, only IEEE-754 can represent NaN. IEEE-754 can be @@ -4230,7 +4229,6 @@ StrictBignumConversion( * Extract the next group of digits. */ - if ((err != MP_OKAY) || (mp_div(&b, &S, &dig, &b) != MP_OKAY) || (dig.used > 1)) { Tcl_Panic("wrong digit!"); } @@ -4848,7 +4846,6 @@ TclBignumToDouble( mp_err err; const mp_int *a = (const mp_int *)big; - /* * We need a 'mantBits'-bit significand. Determine what shift will * give us that. diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 73391fe..6d16be5 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1,9 +1,9 @@ /* * tclStringObj.c -- * - * This file contains functions that implement string operations on Tcl - * objects. Some string operations work with UTF-8 encoding forms. - * Functions that require knowledge of the width of each character, + * This file contains functions that implement string operations on Tcl + * objects. Some string operations work with UTF-8 encoding forms. + * Functions that require knowledge of the width of each character, * such as indexing, operate on fixed width encoding forms such as UTF-32. * * Conceptually, a string is a sequence of Unicode code points. Internally @@ -15,10 +15,10 @@ * numChars, but we don't store the fixed form encoding (unless * Tcl_GetUnicode is explicitly called). * - * The String object type stores one or both formats. The default - * behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is - * stored in the internal rep for future access (without an additional - * O(n) cost). + * The String object type stores one or both formats. The default + * behavior is to store UTF-8. Once UTF-16/UTF32 is calculated, it is + * stored in the internal rep for future access (without an additional + * O(n) cost). * * To allow many appends to be done to an object without constantly * reallocating space, we allocate double the space and use the @@ -459,7 +459,6 @@ TclGetCharLength( return numChars; } - /* *---------------------------------------------------------------------- * @@ -2413,7 +2412,7 @@ Tcl_AppendFormatToObj( numDigits = 1; } TclNewObj(pure); - Tcl_SetObjLength(pure, numDigits); + Tcl_SetObjLength(pure, (Tcl_Size)numDigits); bytes = TclGetString(pure); toAppend = length = numDigits; while (numDigits--) { @@ -3520,7 +3519,6 @@ TclStringCat( *--------------------------------------------------------------------------- */ - static int UniCharNcasememcmp( const void *ucsPtr, /* Unicode string to compare to uct. */ diff --git a/generic/tclStringRep.h b/generic/tclStringRep.h index 4e38a64..a7bca14 100644 --- a/generic/tclStringRep.h +++ b/generic/tclStringRep.h @@ -18,7 +18,6 @@ #ifndef _TCLSTRINGREP #define _TCLSTRINGREP - /* * The following structure is the internal rep for a String object. It keeps * track of how much memory has been used and how much has been allocated for diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c index ad34494..6ac879c 100644 --- a/generic/tclStubLibTbl.c +++ b/generic/tclStubLibTbl.c @@ -33,14 +33,14 @@ MODULE_SCOPE void *tclStubsHandle; */ MODULE_SCOPE const char * TclInitStubTable( - const char *version) /* points to the version field of a - structure variable. */ + const char *version) /* points to the version field of a + * structure variable. */ { if (version) { if (tclStubsHandle == NULL) { - /* This can only happen with -DBUILD_STATIC, so simulate - * that the loading of Tcl succeeded, although we didn't - * actually load it dynamically */ + /* This can only happen with -DBUILD_STATIC, so simulate + * that the loading of Tcl succeeded, although we didn't + * actually load it dynamically */ tclStubsHandle = (void *)1; } tclStubsPtr = ((const TclStubs **) version)[-1]; diff --git a/generic/tclTest.c b/generic/tclTest.c index 3aa066d..b224797 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -21,9 +21,8 @@ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif -#include "tclInt.h" -#undef TCLBOOLWARNING #define TCLBOOLWARNING(boolPtr) /* needed here because we compile with -Wc++-compat */ +#include "tclInt.h" #include "tclOO.h" #include <math.h> @@ -278,6 +277,7 @@ static Tcl_CmdProc Testset2Cmd; static Tcl_CmdProc TestseterrorcodeCmd; static Tcl_ObjCmdProc TestsetobjerrorcodeCmd; static Tcl_CmdProc TestsetplatformCmd; +static Tcl_ObjCmdProc TestSizeCmd; static Tcl_CmdProc TeststaticlibraryCmd; static Tcl_CmdProc TesttranslatefilenameCmd; static Tcl_CmdProc TestupvarCmd; @@ -689,6 +689,7 @@ Tcltest_Init( TestGetIntForIndexCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsetplatform", TestsetplatformCmd, NULL, NULL); + Tcl_CreateObjCommand(interp, "testsize", TestSizeCmd, NULL, NULL); Tcl_CreateCommand(interp, "testsocket", TestSocketCmd, NULL, NULL); Tcl_CreateCommand(interp, "teststaticlibrary", TeststaticlibraryCmd, @@ -4859,6 +4860,27 @@ TestsetplatformCmd( return TCL_OK; } +static int +TestSizeCmd( + TCL_UNUSED(void *), /* Unused */ + Tcl_Interp* interp, /* Tcl interpreter */ + int objc, /* Parameter count */ + Tcl_Obj *const * objv) /* Parameter vector */ +{ + if (objc != 2) { + goto syntax; + } + if (strcmp(Tcl_GetString(objv[1]), "st_mtime") == 0) { + Tcl_StatBuf *statPtr; + Tcl_SetObjResult(interp, Tcl_NewWideIntObj(sizeof(statPtr->st_mtime))); + return TCL_OK; + } + +syntax: + Tcl_WrongNumArgs(interp, 1, objv, "st_mtime"); + return TCL_ERROR; +} + /* *---------------------------------------------------------------------- * diff --git a/generic/tclTestObj.c b/generic/tclTestObj.c index e40d7af..9dc16a7 100644 --- a/generic/tclTestObj.c +++ b/generic/tclTestObj.c @@ -18,6 +18,7 @@ #ifndef USE_TCL_STUBS # define USE_TCL_STUBS #endif +#define TCLBOOLWARNING(boolPtr) /* needed here because we compile with -Wc++-compat */ #include "tclInt.h" #ifdef TCL_WITH_EXTERNAL_TOMMATH # include "tommath.h" @@ -25,8 +26,6 @@ # include "tclTomMath.h" #endif #include "tclStringRep.h" -#undef TCLBOOLWARNING -#define TCLBOOLWARNING(boolPtr) /* needed here because we compile with -Wc++-compat */ #include <assert.h> diff --git a/generic/tclThread.c b/generic/tclThread.c index 698c642..c107780 100644 --- a/generic/tclThread.c +++ b/generic/tclThread.c @@ -145,7 +145,6 @@ RememberSyncObject( void **newList; int i, j; - /* * Reuse any free slot in the list. */ diff --git a/generic/tclTomMathStubLib.c b/generic/tclTomMathStubLib.c index c0786c9..492c95f 100644 --- a/generic/tclTomMathStubLib.c +++ b/generic/tclTomMathStubLib.c @@ -18,7 +18,6 @@ MODULE_SCOPE const TclTomMathStubs *tclTomMathStubsPtr; const TclTomMathStubs *tclTomMathStubsPtr = NULL; - /* *---------------------------------------------------------------------- * diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 33085f3..f4e9fe5 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1016,7 +1016,6 @@ Tcl_TraceCommand( cmdPtr->flags |= CMD_HAS_EXEC_TRACES; } - return TCL_OK; } diff --git a/generic/tclUtf.c b/generic/tclUtf.c index e107081..03ea8b6 100644 --- a/generic/tclUtf.c +++ b/generic/tclUtf.c @@ -1717,7 +1717,6 @@ TclUtfCmp( } return UCHAR(*cs) - UCHAR(*ct); } - /* *---------------------------------------------------------------------- @@ -1757,7 +1756,6 @@ TclUtfCasecmp( } return UCHAR(*cs) - UCHAR(*ct); } - /* *---------------------------------------------------------------------- diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0c9a3b2..fc9cbfe 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -2598,10 +2598,11 @@ char * Tcl_DStringAppend( Tcl_DString *dsPtr, /* Structure describing dynamic string. */ const char *bytes, /* String to append. If length is - * TCL_INDEX_NONE then this must be null-terminated. */ + * TCL_INDEX_NONE then this must be + * null-terminated. */ Tcl_Size length) /* Number of bytes from "bytes" to append. If - * TCL_INDEX_NONE, then append all of bytes, up to null - * at end. */ + * TCL_INDEX_NONE, then append all of bytes, up + * to null at end. */ { Tcl_Size newSize; @@ -2617,7 +2618,6 @@ Tcl_DStringAppend( } newSize = length + dsPtr->length + 1; - if (newSize > dsPtr->spaceAvl) { if (dsPtr->string == dsPtr->staticSpace) { char *newString; @@ -4128,6 +4128,7 @@ TclSetProcessGlobalValue( Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; int dummy; + Tcl_DString ds; Tcl_MutexLock(&pgvPtr->mutex); @@ -4143,8 +4144,12 @@ TclSetProcessGlobalValue( } bytes = TclGetString(newValue); pgvPtr->numBytes = newValue->length; + Tcl_UtfToExternalDStringEx(NULL, encoding, bytes, pgvPtr->numBytes, + TCL_ENCODING_PROFILE_TCL8, &ds, NULL); + pgvPtr->numBytes = Tcl_DStringLength(&ds); pgvPtr->value = (char *)Tcl_Alloc(pgvPtr->numBytes + 1); - memcpy(pgvPtr->value, bytes, pgvPtr->numBytes + 1); + memcpy(pgvPtr->value, Tcl_DStringValue(&ds), pgvPtr->numBytes + 1); + Tcl_DStringFree(&ds); if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); } @@ -4186,6 +4191,7 @@ TclGetProcessGlobalValue( Tcl_HashTable *cacheMap; Tcl_HashEntry *hPtr; Tcl_Size epoch = pgvPtr->epoch; + Tcl_DString newValue; if (pgvPtr->encoding) { Tcl_Encoding current = Tcl_GetEncoding(NULL, NULL); @@ -4197,7 +4203,7 @@ TclGetProcessGlobalValue( * system encoding. */ - Tcl_DString native, newValue; + Tcl_DString native; Tcl_MutexLock(&pgvPtr->mutex); epoch = ++pgvPtr->epoch; @@ -4248,10 +4254,13 @@ TclGetProcessGlobalValue( } /* - * Store a copy of the shared value in our epoch-indexed cache. + * Store a copy of the shared value (but then in utf-8) + * in our epoch-indexed cache. */ - value = Tcl_NewStringObj(pgvPtr->value, pgvPtr->numBytes); + Tcl_ExternalToUtfDString(NULL, pgvPtr->value, pgvPtr->numBytes, &newValue); + value = Tcl_NewStringObj(Tcl_DStringValue(&newValue), Tcl_DStringLength(&newValue)); + Tcl_DStringFree(&newValue); hPtr = Tcl_CreateHashEntry(cacheMap, INT2PTR(pgvPtr->epoch), &dummy); Tcl_MutexUnlock(&pgvPtr->mutex); diff --git a/generic/tclZipfs.c b/generic/tclZipfs.c index 12f0ea0..b0bb383 100644 --- a/generic/tclZipfs.c +++ b/generic/tclZipfs.c @@ -217,9 +217,9 @@ typedef struct ZipEntry { ZipFile *zipFilePtr; /* The ZIP file holding this virtual file */ size_t offset; /* Data offset into memory mapped ZIP file */ int numBytes; /* Uncompressed size of the virtual file. - -1 for zip64 */ + * -1 for zip64 */ int numCompressedBytes; /* Compressed size of the virtual file. - -1 for zip64 */ + * -1 for zip64 */ int compressMethod; /* Compress method */ int isDirectory; /* 0 if file, 1 if directory, -1 if root */ int depth; /* Number of slashes in path. */ @@ -810,11 +810,13 @@ IsCryptHeaderValid( *------------------------------------------------------------------------ */ static int -DecodeCryptHeader(Tcl_Interp *interp, - ZipEntry *z, - unsigned long keys[3],/* Updated on success. Must have been - initialized by caller. */ - unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) /* From zip file content */ +DecodeCryptHeader( + Tcl_Interp *interp, + ZipEntry *z, + unsigned long keys[3], /* Updated on success. Must have been + * initialized by caller. */ + unsigned char cryptHeader[ZIP_CRYPT_HDR_LEN]) + /* From zip file content */ { int i; int ch; @@ -1065,11 +1067,12 @@ errorReturn: *------------------------------------------------------------------------ */ static char * -MapPathToZipfs(Tcl_Interp *interp, - const char *mountPath, /* Must be fully normalized */ - const char *path, /* Archive content path to map */ - Tcl_DString *dsPtr) /* Must be initialized and cleared - by caller */ +MapPathToZipfs( + Tcl_Interp *interp, + const char *mountPath, /* Must be fully normalized */ + const char *path, /* Archive content path to map */ + Tcl_DString *dsPtr) /* Must be initialized and cleared + * by caller */ { const char *joiner[2]; char *joinedPath; diff --git a/generic/tclZlib.c b/generic/tclZlib.c index 4138089..595ddf4 100644 --- a/generic/tclZlib.c +++ b/generic/tclZlib.c @@ -33,11 +33,12 @@ * format or automatic detection of format. Putting it here is slightly less * gross! */ - -#define WBITS_RAW (-MAX_WBITS) -#define WBITS_ZLIB (MAX_WBITS) -#define WBITS_GZIP (MAX_WBITS | 16) -#define WBITS_AUTODETECT (MAX_WBITS | 32) +enum WBitsFlags { + WBITS_RAW = (-MAX_WBITS), /* RAW compressed data */ + WBITS_ZLIB = (MAX_WBITS), /* Zlib-format compressed data */ + WBITS_GZIP = (MAX_WBITS | 16), /* Gzip-format compressed data */ + WBITS_AUTODETECT = (MAX_WBITS | 32) /* Auto-detect format from its header */ +}; /* * Structure used for handling gzip headers that are generated from a @@ -64,7 +65,7 @@ typedef struct { Tcl_Obj *inData, *outData; /* Input / output buffers (lists) */ Tcl_Obj *currentInput; /* Pointer to what is currently being * inflated. */ - Tcl_Size outPos; + Tcl_Size outPos; /* Index into output buffer to write to next. */ int mode; /* Either TCL_ZLIB_STREAM_DEFLATE or * TCL_ZLIB_STREAM_INFLATE. */ int format; /* Flags from the TCL_ZLIB_FORMAT_* */ @@ -82,9 +83,11 @@ typedef struct { * structure. */ } ZlibStreamHandle; -#define DICT_TO_SET 0x1 /* If we need to set a compression dictionary +enum ZlibStreamHandleFlags { + DICT_TO_SET = 0x1 /* If we need to set a compression dictionary * in the low-level engine at the next * opportunity. */ +}; /* * Macros to make it clearer in some of the twiddlier accesses what is @@ -130,21 +133,18 @@ typedef struct { } ZlibChannelData; /* - * Value bits for the flags field. Definitions are: - * ASYNC - Whether this is an asynchronous channel. - * IN_HEADER - Whether the inHeader field has been registered with - * the input compressor. - * OUT_HEADER - Whether the outputHeader field has been registered - * with the output decompressor. - * STREAM_DECOMPRESS - Signal decompress pending data. - * STREAM_DONE - Flag to signal stream end up to transform input. + * Value bits for the ZlibChannelData::flags field. */ - -#define ASYNC 0x01 -#define IN_HEADER 0x02 -#define OUT_HEADER 0x04 -#define STREAM_DECOMPRESS 0x08 -#define STREAM_DONE 0x10 +enum ZlibChannelDataFlags { + ASYNC = 0x01, /* Set if this is an asynchronous channel. */ + IN_HEADER = 0x02, /* Set if the inHeader field has been + * registered with the input compressor. */ + OUT_HEADER = 0x04, /* Set if the outputHeader field has been + * registered with the output decompressor. */ + STREAM_DECOMPRESS = 0x08, /* Set to signal decompress pending data. */ + STREAM_DONE = 0x10 /* Set to signal stream end up to transform + * input. */ +}; /* * Size of buffers allocated by default, and the range it can be set to. The @@ -187,8 +187,9 @@ static int GenerateHeader(Tcl_Interp *interp, Tcl_Obj *dictObj, GzipHeader *headerPtr, int *extraSizePtr); static int ZlibPushSubcmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static int ResultDecompress(ZlibChannelData *cd, char *buf, - int toRead, int flush, int *errorCodePtr); +static int ResultDecompress(ZlibChannelData *chanDataPtr, + char *buf, int toRead, int flush, + int *errorCodePtr); static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp, int mode, int format, int level, int limit, Tcl_Channel channel, Tcl_Obj *gzipHeaderDictPtr, @@ -196,7 +197,8 @@ static Tcl_Channel ZlibStackChannelTransform(Tcl_Interp *interp, static void ZlibStreamCleanup(ZlibStreamHandle *zshPtr); static int ZlibStreamSubcmd(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -static inline void ZlibTransformEventTimerKill(ZlibChannelData *cd); +static inline void ZlibTransformEventTimerKill( + ZlibChannelData *chanDataPtr); static void ZlibTransformTimerRun(void *clientData); /* @@ -214,7 +216,7 @@ static const Tcl_ChannelType zlibChannelType = { ZlibTransformGetOption, ZlibTransformWatch, ZlibTransformGetHandle, - ZlibTransformClose, /* close2Proc */ + ZlibTransformClose, /* close2Proc */ ZlibTransformBlockMode, NULL, /* flushProc */ ZlibTransformEventHandler, @@ -262,7 +264,8 @@ ConvertError( */ case Z_ERRNO: - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_PosixError(interp),-1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_PosixError(interp), TCL_AUTO_LENGTH)); return; /* @@ -313,7 +316,7 @@ ConvertError( snprintf(codeStrBuf, sizeof(codeStrBuf), "%d", code); break; } - Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj(zError(code), TCL_AUTO_LENGTH)); /* * Tricky point! We might pass NULL twice here (and will when the error @@ -350,11 +353,11 @@ ConvertErrorToList( return Tcl_NewListObj(3, objv); case Z_ERRNO: TclNewLiteralStringObj(objv[2], "POSIX"); - objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), -1); + objv[3] = Tcl_NewStringObj(Tcl_ErrnoId(), TCL_AUTO_LENGTH); return Tcl_NewListObj(4, objv); case Z_NEED_DICT: TclNewLiteralStringObj(objv[2], "NEED_DICT"); - TclNewIntObj(objv[3], (Tcl_WideInt)adler); + TclNewIntObj(objv[3], (Tcl_WideInt) adler); return Tcl_NewListObj(4, objv); /* @@ -405,13 +408,26 @@ GetValue( const char *nameStr, Tcl_Obj **valuePtrPtr) { - Tcl_Obj *name = Tcl_NewStringObj(nameStr, -1); + Tcl_Obj *name = Tcl_NewStringObj(nameStr, TCL_AUTO_LENGTH); int result = Tcl_DictObjGet(interp, dictObj, name, valuePtrPtr); TclDecrRefCount(name); return result; } +/* + * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). + */ +static inline Tcl_Encoding +Latin1(void) +{ + Tcl_Encoding latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); + if (latin1enc == NULL) { + Tcl_Panic("no latin-1 encoding"); + } + return latin1enc; +} + static int GenerateHeader( Tcl_Interp *interp, /* Where to put error messages. */ @@ -426,39 +442,31 @@ GenerateHeader( Tcl_Size length; Tcl_WideInt wideValue = 0; const char *valueStr; - Tcl_Encoding latin1enc; + Tcl_Encoding latin1enc = Latin1(); static const char *const types[] = { "binary", "text" }; - /* - * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). - */ - - latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); - if (latin1enc == NULL) { - Tcl_Panic("no latin-1 encoding"); - } - if (GetValue(interp, dictObj, "comment", &value) != TCL_OK) { goto error; } else if (value != NULL) { Tcl_EncodingState state; valueStr = TclGetStringFromObj(value, &length); result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, - TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, &state, - headerPtr->nativeCommentBuf, MAX_COMMENT_LEN-1, NULL, &len, - NULL); + TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, + &state, headerPtr->nativeCommentBuf, MAX_COMMENT_LEN - 1, NULL, + &len, NULL); if (result != TCL_OK) { if (interp) { if (result == TCL_CONVERT_UNKNOWN) { - Tcl_AppendResult( - interp, "Comment contains characters > 0xFF", (char *)NULL); + Tcl_AppendResult(interp, + "Comment contains characters > 0xFF", (char *)NULL); } else { - Tcl_AppendResult(interp, "Comment too large for zip", (char *)NULL); + Tcl_AppendResult(interp, "Comment too large for zip", + (char *)NULL); } } - result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR*/ + result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR */ goto error; } headerPtr->nativeCommentBuf[len] = '\0'; @@ -481,20 +489,20 @@ GenerateHeader( Tcl_EncodingState state; valueStr = TclGetStringFromObj(value, &length); result = Tcl_UtfToExternal(NULL, latin1enc, valueStr, length, - TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, &state, - headerPtr->nativeFilenameBuf, MAXPATHLEN-1, NULL, &len, - NULL); + TCL_ENCODING_START|TCL_ENCODING_END|TCL_ENCODING_PROFILE_STRICT, + &state, headerPtr->nativeFilenameBuf, MAXPATHLEN - 1, NULL, + &len, NULL); if (result != TCL_OK) { if (interp) { if (result == TCL_CONVERT_UNKNOWN) { - Tcl_AppendResult( - interp, "Filename contains characters > 0xFF", (char *)NULL); + Tcl_AppendResult(interp, + "Filename contains characters > 0xFF", (char *)NULL); } else { - Tcl_AppendResult( - interp, "Filename too large for zip", (char *)NULL); + Tcl_AppendResult(interp, + "Filename too large for zip", (char *)NULL); } } - result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR*/ + result = TCL_ERROR; /* TCL_CONVERT_* -> TCL_ERROR */ goto error; } headerPtr->nativeFilenameBuf[len] = '\0'; @@ -555,7 +563,8 @@ GenerateHeader( */ #define SetValue(dictObj, key, value) \ - Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj((key), -1), (value)) + Tcl_DictObjPut(NULL, (dictObj), Tcl_NewStringObj( \ + (key), TCL_AUTO_LENGTH), (value)) static void ExtractHeader( @@ -567,35 +576,21 @@ ExtractHeader( if (headerPtr->comment != Z_NULL) { if (latin1enc == NULL) { - /* - * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). - */ - - latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); - if (latin1enc == NULL) { - Tcl_Panic("no latin-1 encoding"); - } + latin1enc = Latin1(); } - (void)Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, TCL_INDEX_NONE, - &tmp); + (void) Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->comment, + TCL_AUTO_LENGTH, &tmp); SetValue(dictObj, "comment", Tcl_DStringToObj(&tmp)); } SetValue(dictObj, "crc", Tcl_NewBooleanObj(headerPtr->hcrc)); if (headerPtr->name != Z_NULL) { if (latin1enc == NULL) { - /* - * RFC 1952 says that header strings are in ISO 8859-1 (LATIN-1). - */ - - latin1enc = Tcl_GetEncoding(NULL, "iso8859-1"); - if (latin1enc == NULL) { - Tcl_Panic("no latin-1 encoding"); - } + latin1enc = Latin1(); } - (void)Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, TCL_INDEX_NONE, - &tmp); + (void) Tcl_ExternalToUtfDString(latin1enc, (char *) headerPtr->name, + TCL_AUTO_LENGTH, &tmp); SetValue(dictObj, "filename", Tcl_DStringToObj(&tmp)); } if (headerPtr->os != 255) { @@ -605,8 +600,8 @@ ExtractHeader( SetValue(dictObj, "time", Tcl_NewWideIntObj(headerPtr->time)); } if (headerPtr->text != Z_UNKNOWN) { - SetValue(dictObj, "type", - Tcl_NewStringObj(headerPtr->text ? "text" : "binary", -1)); + SetValue(dictObj, "type", Tcl_NewStringObj( + headerPtr->text ? "text" : "binary", TCL_AUTO_LENGTH)); } if (latin1enc != NULL) { @@ -660,11 +655,9 @@ Deflate( int flush, size_t *writtenPtr) { - int e; - strm->next_out = (Bytef *) bufferPtr; strm->avail_out = bufferSize; - e = deflate(strm, flush); + int e = deflate(strm, flush); if (writtenPtr != NULL) { *writtenPtr = bufferSize - strm->avail_out; } @@ -737,7 +730,7 @@ Tcl_ZlibStreamInit( case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; if (dictObj) { - gzHeaderPtr = (GzipHeader *)Tcl_Alloc(sizeof(GzipHeader)); + gzHeaderPtr = (GzipHeader *) Tcl_Alloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); if (GenerateHeader(interp, dictObj, gzHeaderPtr, NULL) != TCL_OK) { @@ -771,7 +764,7 @@ Tcl_ZlibStreamInit( break; case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; - gzHeaderPtr = (GzipHeader *)Tcl_Alloc(sizeof(GzipHeader)); + gzHeaderPtr = (GzipHeader *) Tcl_Alloc(sizeof(GzipHeader)); memset(gzHeaderPtr, 0, sizeof(GzipHeader)); gzHeaderPtr->header.name = (Bytef *) gzHeaderPtr->nativeFilenameBuf; @@ -797,7 +790,7 @@ Tcl_ZlibStreamInit( " TCL_ZLIB_STREAM_INFLATE"); } - zshPtr = (ZlibStreamHandle *)Tcl_Alloc(sizeof(ZlibStreamHandle)); + zshPtr = (ZlibStreamHandle *) Tcl_Alloc(sizeof(ZlibStreamHandle)); zshPtr->interp = interp; zshPtr->mode = mode; zshPtr->format = format; @@ -840,7 +833,8 @@ Tcl_ZlibStreamInit( */ if (interp != NULL) { - if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", TCL_INDEX_NONE, 0) != TCL_OK) { + if (Tcl_EvalEx(interp, "::incr ::tcl::zlib::cmdcounter", + TCL_AUTO_LENGTH, 0) != TCL_OK) { goto error; } Tcl_DStringInit(&cmdname); @@ -849,7 +843,7 @@ Tcl_ZlibStreamInit( if (Tcl_FindCommand(interp, Tcl_DStringValue(&cmdname), NULL, 0) != NULL) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "BUG: Stream command name already exists", -1)); + "BUG: Stream command name already exists", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "BUG", "EXISTING_CMD", (char *)NULL); Tcl_DStringFree(&cmdname); goto error; @@ -922,9 +916,9 @@ Tcl_ZlibStreamInit( static void ZlibStreamCmdDelete( - void *cd) + void *clientData) { - ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd; + ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) clientData; zshPtr->cmd = NULL; ZlibStreamCleanup(zshPtr); @@ -1241,7 +1235,7 @@ Tcl_ZlibStreamPut( if (zshPtr->streamEnd) { if (zshPtr->interp) { Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( - "already past compressed stream end", -1)); + "already past compressed stream end", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "CLOSED", (char *)NULL); } return TCL_ERROR; @@ -1284,7 +1278,7 @@ Tcl_ZlibStreamPut( if (outSize > BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; } - dataTmp = (char *)Tcl_Alloc(outSize); + dataTmp = (char *) Tcl_Alloc(outSize); while (1) { e = Deflate(&zshPtr->stream, dataTmp, outSize, flush, &toStore); @@ -1318,7 +1312,7 @@ Tcl_ZlibStreamPut( if (outSize < BUFFER_SIZE_LIMIT) { outSize = BUFFER_SIZE_LIMIT; /* There may be *lots* of data left to output... */ - dataTmp = (char *)Tcl_Realloc(dataTmp, outSize); + dataTmp = (char *) Tcl_Realloc(dataTmp, outSize); } } @@ -1360,7 +1354,7 @@ int Tcl_ZlibStreamGet( Tcl_ZlibStream zshandle, /* As obtained from Tcl_ZlibStreamInit */ Tcl_Obj *data, /* A place to append the data. */ - Tcl_Size count) /* Number of bytes to grab as a maximum, you + Tcl_Size count) /* Number of bytes to grab as a maximum, you * may get less! */ { ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) zshandle; @@ -1396,7 +1390,7 @@ Tcl_ZlibStreamGet( * Prepare the place to store the data. */ - dataPtr = Tcl_SetByteArrayLength(data, existing+count); + dataPtr = Tcl_SetByteArrayLength(data, existing + count); dataPtr += existing; zshPtr->stream.next_out = dataPtr; @@ -1472,7 +1466,7 @@ Tcl_ZlibStreamGet( if (zshPtr->interp) { Tcl_SetObjResult(zshPtr->interp, Tcl_NewStringObj( "unexpected zlib internal state during" - " decompression", -1)); + " decompression", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(zshPtr->interp, "TCL", "ZIP", "STATE", (char *)NULL); } @@ -1517,7 +1511,7 @@ Tcl_ZlibStreamGet( if (e != Z_NEED_DICT || !HaveDictToSet(zshPtr)) { break; } - e = SetInflateDictionary(&zshPtr->stream,zshPtr->compDictObj); + e = SetInflateDictionary(&zshPtr->stream, zshPtr->compDictObj); DictWasSet(zshPtr); } while (e == Z_OK); } @@ -1570,7 +1564,7 @@ Tcl_ZlibStreamGet( Tcl_ListObjIndex(NULL, zshPtr->outData, 0, &itemObj); itemPtr = Tcl_GetBytesFromObj(NULL, itemObj, &itemLen); - if ((itemLen-zshPtr->outPos) >= count-dataPos) { + if ((itemLen - zshPtr->outPos) >= (count - dataPos)) { Tcl_Size len = count - dataPos; memcpy(dataPtr + dataPos, itemPtr + zshPtr->outPos, len); @@ -1817,10 +1811,10 @@ Tcl_ZlibInflate( if (gzipHeaderDictObj) { headerPtr = &header; memset(headerPtr, 0, sizeof(gz_header)); - nameBuf = (char *)Tcl_Alloc(MAXPATHLEN); + nameBuf = (char *) Tcl_Alloc(MAXPATHLEN); header.name = (Bytef *) nameBuf; header.name_max = MAXPATHLEN - 1; - commentBuf = (char *)Tcl_Alloc(MAX_COMMENT_LEN); + commentBuf = (char *) Tcl_Alloc(MAX_COMMENT_LEN); header.comment = (Bytef *) commentBuf; header.comm_max = MAX_COMMENT_LEN - 1; } @@ -1830,10 +1824,10 @@ Tcl_ZlibInflate( * Start with a buffer (up to) 3 times the size of the input data. */ - if (inLen < 32*1024*1024) { - bufferSize = 3*inLen; - } else if (inLen < 256*1024*1024) { - bufferSize = 2*inLen; + if (inLen < 32 * 1024 * 1024) { + bufferSize = 3 * inLen; + } else if (inLen < 256 * 1024 * 1024) { + bufferSize = 2 * inLen; } else { bufferSize = inLen; } @@ -1843,7 +1837,7 @@ Tcl_ZlibInflate( outData = Tcl_SetByteArrayLength(obj, bufferSize); memset(&stream, 0, sizeof(z_stream)); stream.avail_in = inLen+1; /* +1 because zlib can "over-request" - * input (but ignore it!) */ + * input (but ignore it!) */ stream.next_in = inData; stream.avail_out = bufferSize; stream.next_out = outData; @@ -1887,7 +1881,7 @@ Tcl_ZlibInflate( } newBufferSize = bufferSize + 5 * stream.avail_in; if (newBufferSize == bufferSize) { - newBufferSize = bufferSize+1000; + newBufferSize = bufferSize + 1000; } newOutData = Tcl_SetByteArrayLength(obj, newBufferSize); @@ -1979,6 +1973,8 @@ Tcl_ZlibAdler32( * * Implementation of the [zlib] command. * + * TODO: Convert this to an ensemble. + * *---------------------------------------------------------------------- */ @@ -2017,8 +2013,8 @@ ZlibCmd( } switch (command) { - case CMD_ADLER: /* adler32 str ?startvalue? - * -> checksum */ + case CMD_ADLER: /* adler32 str ?startvalue? + * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; @@ -2027,7 +2023,7 @@ ZlibCmd( if (data == NULL) { return TCL_ERROR; } - if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], + if (objc > 3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } @@ -2037,8 +2033,8 @@ ZlibCmd( Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibAdler32(start, data, dlen))); return TCL_OK; - case CMD_CRC: /* crc32 str ?startvalue? - * -> checksum */ + case CMD_CRC: /* crc32 str ?startvalue? + * -> checksum */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?startValue?"); return TCL_ERROR; @@ -2047,7 +2043,7 @@ ZlibCmd( if (data == NULL) { return TCL_ERROR; } - if (objc>3 && Tcl_GetIntFromObj(interp, objv[3], + if (objc > 3 && Tcl_GetIntFromObj(interp, objv[3], (int *) &start) != TCL_OK) { return TCL_ERROR; } @@ -2057,8 +2053,8 @@ ZlibCmd( Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt) (uLong) Tcl_ZlibCRC32(start, data, dlen))); return TCL_OK; - case CMD_DEFLATE: /* deflate data ?level? - * -> rawCompressedData */ + case CMD_DEFLATE: /* deflate data ?level? + * -> rawCompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?level?"); return TCL_ERROR; @@ -2073,8 +2069,8 @@ ZlibCmd( } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], level, NULL); - case CMD_COMPRESS: /* compress data ?level? - * -> zlibCompressedData */ + case CMD_COMPRESS: /* compress data ?level? + * -> zlibCompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?level?"); return TCL_ERROR; @@ -2089,8 +2085,8 @@ ZlibCmd( } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], level, NULL); - case CMD_GZIP: /* gzip data ?level? - * -> gzippedCompressedData */ + case CMD_GZIP: /* gzip data ?level? + * -> gzippedCompressedData */ headerDictObj = NULL; /* @@ -2123,10 +2119,10 @@ ZlibCmd( } switch (option) { case 0: - headerDictObj = objv[i+1]; + headerDictObj = objv[i + 1]; break; case 1: - if (Tcl_GetIntFromObj(interp, objv[i+1], + if (Tcl_GetIntFromObj(interp, objv[i + 1], &level) != TCL_OK) { return TCL_ERROR; } @@ -2139,8 +2135,8 @@ ZlibCmd( } return Tcl_ZlibDeflate(interp, TCL_ZLIB_FORMAT_GZIP, objv[2], level, headerDictObj); - case CMD_INFLATE: /* inflate rawcomprdata ?bufferSize? - * -> decompressedData */ + case CMD_INFLATE: /* inflate rawcomprdata ?bufferSize? + * -> decompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); return TCL_ERROR; @@ -2158,9 +2154,8 @@ ZlibCmd( } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_RAW, objv[2], buffersize, NULL); - case CMD_DECOMPRESS: /* decompress zlibcomprdata \ - * ?bufferSize? - * -> decompressedData */ + case CMD_DECOMPRESS: /* decompress zlibcomprdata ?bufferSize? + * -> decompressedData */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 2, objv, "data ?bufferSize?"); return TCL_ERROR; @@ -2178,8 +2173,8 @@ ZlibCmd( } return Tcl_ZlibInflate(interp, TCL_ZLIB_FORMAT_ZLIB, objv[2], buffersize, NULL); - case CMD_GUNZIP: { /* gunzip gzippeddata ?bufferSize? - * -> decompressedData */ + case CMD_GUNZIP: { /* gunzip gzippeddata ?-headerVar varName? + * -> decompressedData */ Tcl_Obj *headerVarObj; if (objc < 3 || objc > 5 || ((objc & 1) == 0)) { @@ -2198,7 +2193,7 @@ ZlibCmd( } switch (option) { case 0: - if (TclGetWideIntFromObj(interp, objv[i+1], + if (TclGetWideIntFromObj(interp, objv[i + 1], &wideLen) != TCL_OK) { return TCL_ERROR; } @@ -2209,7 +2204,7 @@ ZlibCmd( buffersize = wideLen; break; case 1: - headerVarObj = objv[i+1]; + headerVarObj = objv[i + 1]; TclNewObj(headerDictObj); break; } @@ -2227,19 +2222,19 @@ ZlibCmd( } return TCL_OK; } - case CMD_STREAM: /* stream deflate/inflate/...gunzip \ - * ?options...? - * -> handleCmd */ + case CMD_STREAM: /* stream deflate/inflate/...gunzip options... + * -> handleCmd */ return ZlibStreamSubcmd(interp, objc, objv); - case CMD_PUSH: /* push mode channel options... - * -> channel */ + case CMD_PUSH: /* push mode channel options... + * -> channel */ return ZlibPushSubcmd(interp, objc, objv); - }; + } return TCL_ERROR; badLevel: - Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "level must be 0 to 9", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", (char *)NULL); if (extraInfoStr) { Tcl_AddErrorInfo(interp, extraInfoStr); @@ -2370,7 +2365,7 @@ ZlibStreamSubcmd( sizeof(OptDescriptor), "option", 0, &option) != TCL_OK) { return TCL_ERROR; } - obj[desc[option].offset] = objv[i+1]; + obj[desc[option].offset] = objv[i + 1]; } /* @@ -2383,7 +2378,8 @@ ZlibStreamSubcmd( } else if (Tcl_GetIntFromObj(interp, levelObj, &level) != TCL_OK) { return TCL_ERROR; } else if (level < 0 || level > 9) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("level must be 0 to 9",-1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "level must be 0 to 9", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", (char *)NULL); Tcl_AddErrorInfo(interp, "\n (in -level option)"); return TCL_ERROR; @@ -2492,7 +2488,7 @@ ZlibPushSubcmd( Tcl_Panic("should be unreachable"); } - if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode, 0) != TCL_OK){ + if (TclGetChannelFromObj(interp, objv[3], &chan, &chanMode, 0) != TCL_OK) { return TCL_ERROR; } @@ -2502,13 +2498,15 @@ ZlibPushSubcmd( if (mode == TCL_ZLIB_STREAM_DEFLATE && !(chanMode & TCL_WRITABLE)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "compression may only be applied to writable channels", -1)); + "compression may only be applied to writable channels", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNWRITABLE", (char *)NULL); return TCL_ERROR; } if (mode == TCL_ZLIB_STREAM_INFLATE && !(chanMode & TCL_READABLE)) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "decompression may only be applied to readable channels",TCL_INDEX_NONE)); + "decompression may only be applied to readable channels", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "UNREADABLE", (char *)NULL); return TCL_ERROR; } @@ -2523,33 +2521,33 @@ ZlibPushSubcmd( &option) != TCL_OK) { return TCL_ERROR; } - if (++i > objc-1) { + if (++i > objc - 1) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "value missing for %s option", pushOptions[option])); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } switch (option) { - case poHeader: + case poHeader: /* -header headerDict */ headerObj = objv[i]; if (Tcl_DictObjSize(interp, headerObj, &dummy) != TCL_OK) { goto genericOptionError; } break; - case poLevel: - if (Tcl_GetIntFromObj(interp, objv[i], (int*) &level) != TCL_OK) { + case poLevel: /* -level compLevel */ + if (Tcl_GetIntFromObj(interp, objv[i], (int *) &level) != TCL_OK) { goto genericOptionError; } if (level < 0 || level > 9) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "level must be 0 to 9", -1)); + "level must be 0 to 9", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "VALUE", "COMPRESSIONLEVEL", (char *)NULL); goto genericOptionError; } break; - case poLimit: - if (Tcl_GetIntFromObj(interp, objv[i], (int*) &limit) != TCL_OK) { + case poLimit: /* -limit numBytes */ + if (Tcl_GetIntFromObj(interp, objv[i], (int *) &limit) != TCL_OK) { goto genericOptionError; } if (limit < 1 || limit > MAX_BUFFER_SIZE) { @@ -2560,11 +2558,11 @@ ZlibPushSubcmd( goto genericOptionError; } break; - case poDictionary: + case poDictionary: /* -dictionary compDict */ if (format == TCL_ZLIB_FORMAT_GZIP) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "a compression dictionary may not be set in the " - "gzip format", -1)); + "gzip format", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOPT", (char *)NULL); goto genericOptionError; } @@ -2573,7 +2571,8 @@ ZlibPushSubcmd( } } - if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, (Tcl_Size *)NULL))) { + if (compDictObj && (NULL == Tcl_GetBytesFromObj(interp, compDictObj, + (Tcl_Size *)NULL))) { return TCL_ERROR; } @@ -2603,12 +2602,12 @@ ZlibPushSubcmd( static int ZlibStreamCmd( - void *cd, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; + Tcl_ZlibStream zstream = (Tcl_ZlibStream) clientData; int count, code; Tcl_Obj *obj; static const char *const cmds[] = { @@ -2729,12 +2728,12 @@ ZlibStreamCmd( static int ZlibStreamAddCmd( - void *cd, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; + Tcl_ZlibStream zstream = (Tcl_ZlibStream) clientData; int code, buffersize = -1, flush = -1, i; Tcl_Obj *obj, *compDictObj = NULL; static const char *const add_options[] = { @@ -2751,32 +2750,32 @@ ZlibStreamAddCmd( } switch (index) { - case ao_flush: /* -flush */ + case ao_flush: /* -flush */ if (flush >= 0) { flush = -2; } else { flush = Z_SYNC_FLUSH; } break; - case ao_fullflush: /* -fullflush */ + case ao_fullflush: /* -fullflush */ if (flush >= 0) { flush = -2; } else { flush = Z_FULL_FLUSH; } break; - case ao_finalize: /* -finalize */ + case ao_finalize: /* -finalize */ if (flush >= 0) { flush = -2; } else { flush = Z_FINISH; } break; - case ao_buffer: /* -buffer */ - if (i == objc-2) { + case ao_buffer: /* -buffer bufferSize */ + if (i == objc - 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-buffer\" option must be followed by integer " - "decompression buffersize", -1)); + "decompression buffersize", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } @@ -2791,11 +2790,11 @@ ZlibStreamAddCmd( return TCL_ERROR; } break; - case ao_dictionary: - if (i == objc-2) { + case ao_dictionary: /* -dictionary compDict */ + if (i == objc - 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" - " compression dictionary bytes", -1)); + " compression dictionary bytes", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } @@ -2806,7 +2805,7 @@ ZlibStreamAddCmd( if (flush == -2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", -1)); + " are mutually exclusive", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", (char *)NULL); return TCL_ERROR; } @@ -2836,7 +2835,7 @@ ZlibStreamAddCmd( * Send the data to the stream core, along with any flushing directive. */ - if (Tcl_ZlibStreamPut(zstream, objv[objc-1], flush) != TCL_OK) { + if (Tcl_ZlibStreamPut(zstream, objv[objc - 1], flush) != TCL_OK) { return TCL_ERROR; } @@ -2856,12 +2855,12 @@ ZlibStreamAddCmd( static int ZlibStreamPutCmd( - void *cd, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - Tcl_ZlibStream zstream = (Tcl_ZlibStream)cd; + Tcl_ZlibStream zstream = (Tcl_ZlibStream) clientData; int flush = -1, i; Tcl_Obj *compDictObj = NULL; static const char *const put_options[] = { @@ -2878,32 +2877,32 @@ ZlibStreamPutCmd( } switch (index) { - case po_flush: /* -flush */ + case po_flush: /* -flush */ if (flush >= 0) { flush = -2; } else { flush = Z_SYNC_FLUSH; } break; - case po_fullflush: /* -fullflush */ + case po_fullflush: /* -fullflush */ if (flush >= 0) { flush = -2; } else { flush = Z_FULL_FLUSH; } break; - case po_finalize: /* -finalize */ + case po_finalize: /* -finalize */ if (flush >= 0) { flush = -2; } else { flush = Z_FINISH; } break; - case po_dictionary: - if (i == objc-2) { + case po_dictionary: /* -dictionary compDict */ + if (i == objc - 2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-dictionary\" option must be followed by" - " compression dictionary bytes", -1)); + " compression dictionary bytes", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "NOVAL", (char *)NULL); return TCL_ERROR; } @@ -2913,7 +2912,7 @@ ZlibStreamPutCmd( if (flush == -2) { Tcl_SetObjResult(interp, Tcl_NewStringObj( "\"-flush\", \"-fullflush\" and \"-finalize\" options" - " are mutually exclusive", -1)); + " are mutually exclusive", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "EXCLUSIVE", (char *)NULL); return TCL_ERROR; } @@ -2942,17 +2941,17 @@ ZlibStreamPutCmd( * Send the data to the stream core, along with any flushing directive. */ - return Tcl_ZlibStreamPut(zstream, objv[objc-1], flush); + return Tcl_ZlibStreamPut(zstream, objv[objc - 1], flush); } static int ZlibStreamHeaderCmd( - void *cd, + void *clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]) { - ZlibStreamHandle *zshPtr = (ZlibStreamHandle *)cd; + ZlibStreamHandle *zshPtr = (ZlibStreamHandle *) clientData; Tcl_Obj *resultObj; if (objc != 2) { @@ -2961,7 +2960,8 @@ ZlibStreamHeaderCmd( } else if (zshPtr->mode != TCL_ZLIB_STREAM_INFLATE || zshPtr->format != TCL_ZLIB_FORMAT_GZIP) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "only gunzip streams can produce header information", -1)); + "only gunzip streams can produce header information", + TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "ZIP", "BADOP", (char *)NULL); return TCL_ERROR; } @@ -2976,6 +2976,17 @@ ZlibStreamHeaderCmd( *---------------------------------------------------------------------- * Set of functions to support channel stacking. *---------------------------------------------------------------------- + */ + +static inline int +HaveFlag( + ZlibChannelData *chanDataPtr, + int flag) +{ + return (chanDataPtr->flags & flag) != 0; +} + +/* * * ZlibTransformClose -- * @@ -2988,9 +2999,9 @@ static int ZlibTransformClose( void *instanceData, Tcl_Interp *interp, - int flags) + int flags) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; int e, result = TCL_OK; size_t written; @@ -3002,17 +3013,17 @@ ZlibTransformClose( * Delete the support timer. */ - ZlibTransformEventTimerKill(cd); + ZlibTransformEventTimerKill(chanDataPtr); /* * Flush any data waiting to be compressed. */ - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - cd->outStream.avail_in = 0; + if (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { + chanDataPtr->outStream.avail_in = 0; do { - e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated, - Z_FINISH, &written); + e = Deflate(&chanDataPtr->outStream, chanDataPtr->outBuffer, + chanDataPtr->outAllocated, Z_FINISH, &written); /* * Can't be sure that deflate() won't declare the buffer to be @@ -3021,17 +3032,18 @@ ZlibTransformClose( if (e == Z_BUF_ERROR) { e = Z_OK; - written = cd->outAllocated; + written = chanDataPtr->outAllocated; } if (e != Z_OK && e != Z_STREAM_END) { /* TODO: is this the right way to do errors on close? */ if (!TclInThreadExit()) { - ConvertError(interp, e, cd->outStream.adler); + ConvertError(interp, e, chanDataPtr->outStream.adler); } result = TCL_ERROR; break; } - if (written && Tcl_WriteRaw(cd->parent, cd->outBuffer, written) == TCL_IO_FAILURE) { + if (written && Tcl_WriteRaw(chanDataPtr->parent, + chanDataPtr->outBuffer, written) == TCL_IO_FAILURE) { /* TODO: is this the right way to do errors on close? * Note: when close is called from FinalizeIOSubsystem then * interp may be NULL */ @@ -3044,38 +3056,40 @@ ZlibTransformClose( break; } } while (e != Z_STREAM_END); - (void) deflateEnd(&cd->outStream); + (void) deflateEnd(&chanDataPtr->outStream); } else { /* * If we have unused bytes from the read input (overshot by * Z_STREAM_END or on possible error), unget them back to the parent * channel, so that they appear as not being read yet. */ - if (cd->inStream.avail_in) { - Tcl_Ungets (cd->parent, (char *)cd->inStream.next_in, cd->inStream.avail_in, 0); + if (chanDataPtr->inStream.avail_in) { + Tcl_Ungets(chanDataPtr->parent, + (char *) chanDataPtr->inStream.next_in, + chanDataPtr->inStream.avail_in, 0); } - (void) inflateEnd(&cd->inStream); + (void) inflateEnd(&chanDataPtr->inStream); } /* * Release all memory. */ - if (cd->compDictObj) { - Tcl_DecrRefCount(cd->compDictObj); - cd->compDictObj = NULL; + if (chanDataPtr->compDictObj) { + Tcl_DecrRefCount(chanDataPtr->compDictObj); + chanDataPtr->compDictObj = NULL; } - if (cd->inBuffer) { - Tcl_Free(cd->inBuffer); - cd->inBuffer = NULL; + if (chanDataPtr->inBuffer) { + Tcl_Free(chanDataPtr->inBuffer); + chanDataPtr->inBuffer = NULL; } - if (cd->outBuffer) { - Tcl_Free(cd->outBuffer); - cd->outBuffer = NULL; + if (chanDataPtr->outBuffer) { + Tcl_Free(chanDataPtr->outBuffer); + chanDataPtr->outBuffer = NULL; } - Tcl_Free(cd); + Tcl_Free(chanDataPtr); return result; } @@ -3096,31 +3110,32 @@ ZlibTransformInput( int toRead, int *errorCodePtr) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverInputProc *inProc = - Tcl_ChannelInputProc(Tcl_GetChannelType(cd->parent)); + Tcl_ChannelInputProc(Tcl_GetChannelType(chanDataPtr->parent)); int readBytes, gotBytes; - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - return inProc(Tcl_GetChannelInstanceData(cd->parent), buf, toRead, - errorCodePtr); + if (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { + return inProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), buf, + toRead, errorCodePtr); } gotBytes = 0; - readBytes = cd->inStream.avail_in; /* how many bytes in buffer now */ - while (!(cd->flags & STREAM_DONE) && toRead > 0) { - unsigned int n; int decBytes; + readBytes = chanDataPtr->inStream.avail_in; /* how many bytes in buffer now */ + while (!HaveFlag(chanDataPtr, STREAM_DONE) && toRead > 0) { + unsigned int n; + int decBytes; /* if starting from scratch or continuation after full decompression */ - if (!cd->inStream.avail_in) { + if (!chanDataPtr->inStream.avail_in) { /* buffer to start, we can read to whole available buffer */ - cd->inStream.next_in = (Bytef *) cd->inBuffer; + chanDataPtr->inStream.next_in = (Bytef *) chanDataPtr->inBuffer; } /* * If done - no read needed anymore, check we have to copy rest of * decompressed data, otherwise return with size (or 0 for Eof) */ - if (cd->flags & STREAM_DECOMPRESS) { + if (HaveFlag(chanDataPtr, STREAM_DECOMPRESS)) { goto copyDecompressed; } /* @@ -3131,7 +3146,8 @@ ZlibTransformInput( */ /* Check free buffer size and adjust size of next chunk to read. */ - n = cd->inAllocated - ((char *)cd->inStream.next_in - cd->inBuffer); + n = chanDataPtr->inAllocated - ((char *) + chanDataPtr->inStream.next_in - chanDataPtr->inBuffer); if (n <= 0) { /* Normally unreachable: not enough input buffer to uncompress. * Todo: firstly try to realloc inBuffer upto MAX_BUFFER_SIZE. @@ -3139,10 +3155,11 @@ ZlibTransformInput( *errorCodePtr = ENOBUFS; return -1; } - if (n > cd->readAheadLimit) { - n = cd->readAheadLimit; + if (n > chanDataPtr->readAheadLimit) { + n = chanDataPtr->readAheadLimit; } - readBytes = Tcl_ReadRaw(cd->parent, (char *)cd->inStream.next_in, n); + readBytes = Tcl_ReadRaw(chanDataPtr->parent, + (char *) chanDataPtr->inStream.next_in, n); /* * Three cases here: @@ -3155,9 +3172,8 @@ ZlibTransformInput( */ if (readBytes == -1) { - /* See ReflectInput() in tclIORTrans.c */ - if (Tcl_InputBlocked(cd->parent) && (gotBytes > 0)) { + if (Tcl_InputBlocked(chanDataPtr->parent) && (gotBytes > 0)) { break; } @@ -3166,7 +3182,7 @@ ZlibTransformInput( } /* more bytes (or Eof if readBytes == 0) */ - cd->inStream.avail_in += readBytes; + chanDataPtr->inStream.avail_in += readBytes; copyDecompressed: @@ -3178,9 +3194,8 @@ copyDecompressed: * partial data waiting is converted and returned. */ - decBytes = ResultDecompress(cd, buf, toRead, - (readBytes != 0) ? Z_NO_FLUSH : Z_SYNC_FLUSH, - errorCodePtr); + decBytes = ResultDecompress(chanDataPtr, buf, toRead, + (readBytes != 0) ? Z_NO_FLUSH : Z_SYNC_FLUSH, errorCodePtr); if (decBytes == -1) { return -1; } @@ -3188,15 +3203,15 @@ copyDecompressed: buf += decBytes; toRead -= decBytes; - if (((decBytes == 0) || (cd->flags & STREAM_DECOMPRESS))) { + if ((decBytes == 0) || HaveFlag(chanDataPtr, STREAM_DECOMPRESS)) { /* * The drain delivered nothing (or buffer too small to decompress). * Time to deliver what we've got. */ - if (!gotBytes && !(cd->flags & STREAM_DONE)) { + if (!gotBytes && !HaveFlag(chanDataPtr, STREAM_DONE)) { /* if no-data, but not ready - avoid signaling Eof, * continue in blocking mode, otherwise EAGAIN */ - if (Tcl_InputBlocked(cd->parent)) { + if (Tcl_InputBlocked(chanDataPtr->parent)) { continue; } *errorCodePtr = EAGAIN; @@ -3231,16 +3246,16 @@ ZlibTransformOutput( int toWrite, int *errorCodePtr) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverOutputProc *outProc = - Tcl_ChannelOutputProc(Tcl_GetChannelType(cd->parent)); + Tcl_ChannelOutputProc(Tcl_GetChannelType(chanDataPtr->parent)); int e; size_t produced; Tcl_Obj *errObj; - if (cd->mode == TCL_ZLIB_STREAM_INFLATE) { - return outProc(Tcl_GetChannelInstanceData(cd->parent), buf, toWrite, - errorCodePtr); + if (chanDataPtr->mode == TCL_ZLIB_STREAM_INFLATE) { + return outProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), buf, + toWrite, errorCodePtr); } /* @@ -3251,32 +3266,34 @@ ZlibTransformOutput( return 0; } - cd->outStream.next_in = (Bytef *) buf; - cd->outStream.avail_in = toWrite; - while (cd->outStream.avail_in > 0) { - e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated, - Z_NO_FLUSH, &produced); + chanDataPtr->outStream.next_in = (Bytef *) buf; + chanDataPtr->outStream.avail_in = toWrite; + while (chanDataPtr->outStream.avail_in > 0) { + e = Deflate(&chanDataPtr->outStream, chanDataPtr->outBuffer, + chanDataPtr->outAllocated, Z_NO_FLUSH, &produced); if (e != Z_OK || produced == 0) { break; } - if (Tcl_WriteRaw(cd->parent, cd->outBuffer, produced) == TCL_IO_FAILURE) { + if (Tcl_WriteRaw(chanDataPtr->parent, chanDataPtr->outBuffer, + produced) == TCL_IO_FAILURE) { *errorCodePtr = Tcl_GetErrno(); return -1; } } if (e == Z_OK) { - return toWrite - cd->outStream.avail_in; + return toWrite - chanDataPtr->outStream.avail_in; } errObj = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1)); + Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj( + "-errorcode", TCL_AUTO_LENGTH)); Tcl_ListObjAppendElement(NULL, errObj, - ConvertErrorToList(e, cd->outStream.adler)); + ConvertErrorToList(e, chanDataPtr->outStream.adler)); Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->outStream.msg, -1)); - Tcl_SetChannelError(cd->parent, errObj); + Tcl_NewStringObj(chanDataPtr->outStream.msg, TCL_AUTO_LENGTH)); + Tcl_SetChannelError(chanDataPtr->parent, errObj); *errorCodePtr = EINVAL; return -1; } @@ -3294,22 +3311,22 @@ ZlibTransformOutput( static int ZlibTransformFlush( Tcl_Interp *interp, - ZlibChannelData *cd, + ZlibChannelData *chanDataPtr, int flushType) { int e; size_t len; - cd->outStream.avail_in = 0; + chanDataPtr->outStream.avail_in = 0; do { /* * Get the bytes to go out of the compression engine. */ - e = Deflate(&cd->outStream, cd->outBuffer, cd->outAllocated, - flushType, &len); + e = Deflate(&chanDataPtr->outStream, chanDataPtr->outBuffer, + chanDataPtr->outAllocated, flushType, &len); if (e != Z_OK && e != Z_BUF_ERROR) { - ConvertError(interp, e, cd->outStream.adler); + ConvertError(interp, e, chanDataPtr->outStream.adler); return TCL_ERROR; } @@ -3317,7 +3334,8 @@ ZlibTransformFlush( * Write the bytes we've received to the next layer. */ - if (len > 0 && Tcl_WriteRaw(cd->parent, cd->outBuffer, len) == TCL_IO_FAILURE) { + if (len > 0 && Tcl_WriteRaw(chanDataPtr->parent, chanDataPtr->outBuffer, + len) == TCL_IO_FAILURE) { Tcl_SetObjResult(interp, Tcl_ObjPrintf( "problem flushing channel: %s", Tcl_PosixError(interp))); @@ -3354,17 +3372,17 @@ ZlibTransformSetOption( /* not used */ const char *optionName, const char *value) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverSetOptionProc *setOptionProc = - Tcl_ChannelSetOptionProc(Tcl_GetChannelType(cd->parent)); + Tcl_ChannelSetOptionProc(Tcl_GetChannelType(chanDataPtr->parent)); static const char *compressChanOptions = "dictionary flush"; static const char *gzipChanOptions = "flush"; static const char *decompressChanOptions = "dictionary limit"; static const char *gunzipChanOptions = "flush limit"; - int haveFlushOpt = (cd->mode == TCL_ZLIB_STREAM_DEFLATE); + int haveFlushOpt = (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE); if (optionName && (strcmp(optionName, "-dictionary") == 0) - && (cd->format != TCL_ZLIB_FORMAT_GZIP)) { + && (chanDataPtr->format != TCL_ZLIB_FORMAT_GZIP)) { Tcl_Obj *compDictObj; int code; @@ -3374,21 +3392,21 @@ ZlibTransformSetOption( /* not used */ Tcl_DecrRefCount(compDictObj); return TCL_ERROR; } - if (cd->compDictObj) { - TclDecrRefCount(cd->compDictObj); + if (chanDataPtr->compDictObj) { + TclDecrRefCount(chanDataPtr->compDictObj); } - cd->compDictObj = compDictObj; + chanDataPtr->compDictObj = compDictObj; code = Z_OK; - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - code = SetDeflateDictionary(&cd->outStream, compDictObj); + if (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { + code = SetDeflateDictionary(&chanDataPtr->outStream, compDictObj); if (code != Z_OK) { - ConvertError(interp, code, cd->outStream.adler); + ConvertError(interp, code, chanDataPtr->outStream.adler); return TCL_ERROR; } - } else if (cd->format == TCL_ZLIB_FORMAT_RAW) { - code = SetInflateDictionary(&cd->inStream, compDictObj); + } else if (chanDataPtr->format == TCL_ZLIB_FORMAT_RAW) { + code = SetInflateDictionary(&chanDataPtr->inStream, compDictObj); if (code != Z_OK) { - ConvertError(interp, code, cd->inStream.adler); + ConvertError(interp, code, chanDataPtr->inStream.adler); return TCL_ERROR; } } @@ -3415,7 +3433,7 @@ ZlibTransformSetOption( /* not used */ * Try to actually do the flush now. */ - return ZlibTransformFlush(interp, cd, flushType); + return ZlibTransformFlush(interp, chanDataPtr, flushType); } } else { if (optionName && strcmp(optionName, "-limit") == 0) { @@ -3425,21 +3443,22 @@ ZlibTransformSetOption( /* not used */ return TCL_ERROR; } else if (newLimit < 1 || newLimit > MAX_BUFFER_SIZE) { Tcl_SetObjResult(interp, Tcl_NewStringObj( - "-limit must be between 1 and 65536", -1)); - Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", (char *)NULL); + "-limit must be between 1 and 65536", TCL_AUTO_LENGTH)); + Tcl_SetErrorCode(interp, "TCL", "VALUE", "READLIMIT", + (char *)NULL); return TCL_ERROR; } } } if (setOptionProc == NULL) { - if (cd->format == TCL_ZLIB_FORMAT_GZIP) { + if (chanDataPtr->format == TCL_ZLIB_FORMAT_GZIP) { return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) + (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) ? gzipChanOptions : gunzipChanOptions); } else { return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) + (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) ? compressChanOptions : decompressChanOptions); } } @@ -3449,8 +3468,8 @@ ZlibTransformSetOption( /* not used */ * channel. */ - return setOptionProc(Tcl_GetChannelInstanceData(cd->parent), interp, - optionName, value); + return setOptionProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), + interp, optionName, value); } /* @@ -3470,9 +3489,9 @@ ZlibTransformGetOption( const char *optionName, Tcl_DString *dsPtr) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverGetOptionProc *getOptionProc = - Tcl_ChannelGetOptionProc(Tcl_GetChannelType(cd->parent)); + Tcl_ChannelGetOptionProc(Tcl_GetChannelType(chanDataPtr->parent)); static const char *compressChanOptions = "checksum dictionary"; static const char *gzipChanOptions = "checksum"; static const char *decompressChanOptions = "checksum dictionary limit"; @@ -3488,10 +3507,10 @@ ZlibTransformGetOption( uLong crc; char buf[12]; - if (cd->mode == TCL_ZLIB_STREAM_DEFLATE) { - crc = cd->outStream.adler; + if (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) { + crc = chanDataPtr->outStream.adler; } else { - crc = cd->inStream.adler; + crc = chanDataPtr->inStream.adler; } snprintf(buf, sizeof(buf), "%lu", crc); @@ -3499,12 +3518,12 @@ ZlibTransformGetOption( Tcl_DStringAppendElement(dsPtr, "-checksum"); Tcl_DStringAppendElement(dsPtr, buf); } else { - Tcl_DStringAppend(dsPtr, buf, -1); + Tcl_DStringAppend(dsPtr, buf, TCL_AUTO_LENGTH); return TCL_OK; } } - if ((cd->format != TCL_ZLIB_FORMAT_GZIP) && + if ((chanDataPtr->format != TCL_ZLIB_FORMAT_GZIP) && (optionName == NULL || strcmp(optionName, "-dictionary") == 0)) { /* * Embedded NUL bytes are ok; they'll be C080-encoded. @@ -3512,16 +3531,17 @@ ZlibTransformGetOption( if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-dictionary"); - if (cd->compDictObj) { + if (chanDataPtr->compDictObj) { Tcl_DStringAppendElement(dsPtr, - TclGetString(cd->compDictObj)); + TclGetString(chanDataPtr->compDictObj)); } else { Tcl_DStringAppendElement(dsPtr, ""); } } else { - if (cd->compDictObj) { + if (chanDataPtr->compDictObj) { Tcl_Size length; - const char *str = TclGetStringFromObj(cd->compDictObj, &length); + const char *str = TclGetStringFromObj(chanDataPtr->compDictObj, + &length); Tcl_DStringAppend(dsPtr, str, length); } @@ -3534,12 +3554,12 @@ ZlibTransformGetOption( * reports the header that has been read from the start of the stream. */ - if ((cd->flags & IN_HEADER) && ((optionName == NULL) || + if (HaveFlag(chanDataPtr, IN_HEADER) && ((optionName == NULL) || (strcmp(optionName, "-header") == 0))) { Tcl_Obj *tmpObj; TclNewObj(tmpObj); - ExtractHeader(&cd->inHeader.header, tmpObj); + ExtractHeader(&chanDataPtr->inHeader.header, tmpObj); if (optionName == NULL) { Tcl_DStringAppendElement(dsPtr, "-header"); Tcl_DStringAppendElement(dsPtr, TclGetString(tmpObj)); @@ -3556,19 +3576,19 @@ ZlibTransformGetOption( */ if (getOptionProc) { - return getOptionProc(Tcl_GetChannelInstanceData(cd->parent), + return getOptionProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), interp, optionName, dsPtr); } if (optionName == NULL) { return TCL_OK; } - if (cd->format == TCL_ZLIB_FORMAT_GZIP) { + if (chanDataPtr->format == TCL_ZLIB_FORMAT_GZIP) { return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) + (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) ? gzipChanOptions : gunzipChanOptions); } else { return Tcl_BadChannelOption(interp, optionName, - (cd->mode == TCL_ZLIB_STREAM_DEFLATE) + (chanDataPtr->mode == TCL_ZLIB_STREAM_DEFLATE) ? compressChanOptions : decompressChanOptions); } } @@ -3589,21 +3609,21 @@ ZlibTransformWatch( void *instanceData, int mask) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; Tcl_DriverWatchProc *watchProc; /* * This code is based on the code in tclIORTrans.c */ - watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(cd->parent)); - watchProc(Tcl_GetChannelInstanceData(cd->parent), mask); + watchProc = Tcl_ChannelWatchProc(Tcl_GetChannelType(chanDataPtr->parent)); + watchProc(Tcl_GetChannelInstanceData(chanDataPtr->parent), mask); - if (!(mask & TCL_READABLE) || !(cd->flags & STREAM_DECOMPRESS)) { - ZlibTransformEventTimerKill(cd); - } else if (cd->timer == NULL) { - cd->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, - ZlibTransformTimerRun, cd); + if (!(mask & TCL_READABLE) || !HaveFlag(chanDataPtr, STREAM_DECOMPRESS)) { + ZlibTransformEventTimerKill(chanDataPtr); + } else if (chanDataPtr->timer == NULL) { + chanDataPtr->timer = Tcl_CreateTimerHandler(SYNTHETIC_EVENT_TIME, + ZlibTransformTimerRun, chanDataPtr); } } @@ -3612,19 +3632,19 @@ ZlibTransformEventHandler( void *instanceData, int interestMask) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; - ZlibTransformEventTimerKill(cd); + ZlibTransformEventTimerKill(chanDataPtr); return interestMask; } static inline void ZlibTransformEventTimerKill( - ZlibChannelData *cd) + ZlibChannelData *chanDataPtr) { - if (cd->timer != NULL) { - Tcl_DeleteTimerHandler(cd->timer); - cd->timer = NULL; + if (chanDataPtr->timer != NULL) { + Tcl_DeleteTimerHandler(chanDataPtr->timer); + chanDataPtr->timer = NULL; } } @@ -3632,10 +3652,10 @@ static void ZlibTransformTimerRun( void *clientData) { - ZlibChannelData *cd = (ZlibChannelData *)clientData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) clientData; - cd->timer = NULL; - Tcl_NotifyChannel(cd->chan, TCL_READABLE); + chanDataPtr->timer = NULL; + Tcl_NotifyChannel(chanDataPtr->chan, TCL_READABLE); } /* @@ -3655,9 +3675,9 @@ ZlibTransformGetHandle( int direction, void **handlePtr) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; - return Tcl_GetChannelHandle(cd->parent, direction, handlePtr); + return Tcl_GetChannelHandle(chanDataPtr->parent, direction, handlePtr); } /* @@ -3675,12 +3695,12 @@ ZlibTransformBlockMode( void *instanceData, int mode) { - ZlibChannelData *cd = (ZlibChannelData *)instanceData; + ZlibChannelData *chanDataPtr = (ZlibChannelData *) instanceData; if (mode == TCL_MODE_NONBLOCKING) { - cd->flags |= ASYNC; + chanDataPtr->flags |= ASYNC; } else { - cd->flags &= ~ASYNC; + chanDataPtr->flags &= ~ASYNC; } return TCL_OK; } @@ -3725,7 +3745,8 @@ ZlibStackChannelTransform( * dictionary (not dictObj!) to use if * necessary. */ { - ZlibChannelData *cd = (ZlibChannelData *)Tcl_Alloc(sizeof(ZlibChannelData)); + ZlibChannelData *chanDataPtr = (ZlibChannelData *) + Tcl_Alloc(sizeof(ZlibChannelData)); Tcl_Channel chan; int wbits = 0; @@ -3733,46 +3754,51 @@ ZlibStackChannelTransform( Tcl_Panic("unknown mode: %d", mode); } - memset(cd, 0, sizeof(ZlibChannelData)); - cd->mode = mode; - cd->format = format; - cd->readAheadLimit = limit; + memset(chanDataPtr, 0, sizeof(ZlibChannelData)); + chanDataPtr->mode = mode; + chanDataPtr->format = format; + chanDataPtr->readAheadLimit = limit; if (format == TCL_ZLIB_FORMAT_GZIP || format == TCL_ZLIB_FORMAT_AUTO) { if (mode == TCL_ZLIB_STREAM_DEFLATE) { if (gzipHeaderDictPtr) { - cd->flags |= OUT_HEADER; - if (GenerateHeader(interp, gzipHeaderDictPtr, &cd->outHeader, - NULL) != TCL_OK) { + chanDataPtr->flags |= OUT_HEADER; + if (GenerateHeader(interp, gzipHeaderDictPtr, + &chanDataPtr->outHeader, NULL) != TCL_OK) { goto error; } } } else { - cd->flags |= IN_HEADER; - cd->inHeader.header.name = (Bytef *) - &cd->inHeader.nativeFilenameBuf; - cd->inHeader.header.name_max = MAXPATHLEN - 1; - cd->inHeader.header.comment = (Bytef *) - &cd->inHeader.nativeCommentBuf; - cd->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; + chanDataPtr->flags |= IN_HEADER; + chanDataPtr->inHeader.header.name = (Bytef *) + &chanDataPtr->inHeader.nativeFilenameBuf; + chanDataPtr->inHeader.header.name_max = MAXPATHLEN - 1; + chanDataPtr->inHeader.header.comment = (Bytef *) + &chanDataPtr->inHeader.nativeCommentBuf; + chanDataPtr->inHeader.header.comm_max = MAX_COMMENT_LEN - 1; } } if (compDictObj != NULL) { - cd->compDictObj = Tcl_DuplicateObj(compDictObj); - Tcl_IncrRefCount(cd->compDictObj); - Tcl_GetBytesFromObj(NULL, cd->compDictObj, (Tcl_Size *)NULL); + chanDataPtr->compDictObj = Tcl_DuplicateObj(compDictObj); + Tcl_IncrRefCount(chanDataPtr->compDictObj); + Tcl_GetBytesFromObj(NULL, chanDataPtr->compDictObj, (Tcl_Size *)NULL); } - if (format == TCL_ZLIB_FORMAT_RAW) { + switch (format) { + case TCL_ZLIB_FORMAT_RAW: wbits = WBITS_RAW; - } else if (format == TCL_ZLIB_FORMAT_ZLIB) { + break; + case TCL_ZLIB_FORMAT_ZLIB: wbits = WBITS_ZLIB; - } else if (format == TCL_ZLIB_FORMAT_GZIP) { + break; + case TCL_ZLIB_FORMAT_GZIP: wbits = WBITS_GZIP; - } else if (format == TCL_ZLIB_FORMAT_AUTO) { + break; + case TCL_ZLIB_FORMAT_AUTO: wbits = WBITS_AUTODETECT; - } else { + break; + default: Tcl_Panic("bad format: %d", format); } @@ -3781,66 +3807,72 @@ ZlibStackChannelTransform( */ if (mode == TCL_ZLIB_STREAM_INFLATE) { - if (inflateInit2(&cd->inStream, wbits) != Z_OK) { + if (inflateInit2(&chanDataPtr->inStream, wbits) != Z_OK) { goto error; } - cd->inAllocated = DEFAULT_BUFFER_SIZE; - if (cd->inAllocated < cd->readAheadLimit) { - cd->inAllocated = cd->readAheadLimit; + chanDataPtr->inAllocated = DEFAULT_BUFFER_SIZE; + if (chanDataPtr->inAllocated < chanDataPtr->readAheadLimit) { + chanDataPtr->inAllocated = chanDataPtr->readAheadLimit; } - cd->inBuffer = (char *)Tcl_Alloc(cd->inAllocated); - if (cd->flags & IN_HEADER) { - if (inflateGetHeader(&cd->inStream, &cd->inHeader.header) != Z_OK) { + chanDataPtr->inBuffer = (char *) Tcl_Alloc(chanDataPtr->inAllocated); + if (HaveFlag(chanDataPtr, IN_HEADER)) { + if (inflateGetHeader(&chanDataPtr->inStream, + &chanDataPtr->inHeader.header) != Z_OK) { goto error; } } - if (cd->format == TCL_ZLIB_FORMAT_RAW && cd->compDictObj) { - if (SetInflateDictionary(&cd->inStream, cd->compDictObj) != Z_OK) { + if (chanDataPtr->format == TCL_ZLIB_FORMAT_RAW + && chanDataPtr->compDictObj) { + if (SetInflateDictionary(&chanDataPtr->inStream, + chanDataPtr->compDictObj) != Z_OK) { goto error; } } } else { - if (deflateInit2(&cd->outStream, level, Z_DEFLATED, wbits, + if (deflateInit2(&chanDataPtr->outStream, level, Z_DEFLATED, wbits, MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY) != Z_OK) { goto error; } - cd->outAllocated = DEFAULT_BUFFER_SIZE; - cd->outBuffer = (char *)Tcl_Alloc(cd->outAllocated); - if (cd->flags & OUT_HEADER) { - if (deflateSetHeader(&cd->outStream, &cd->outHeader.header) != Z_OK) { + chanDataPtr->outAllocated = DEFAULT_BUFFER_SIZE; + chanDataPtr->outBuffer = (char *) Tcl_Alloc(chanDataPtr->outAllocated); + if (HaveFlag(chanDataPtr, OUT_HEADER)) { + if (deflateSetHeader(&chanDataPtr->outStream, + &chanDataPtr->outHeader.header) != Z_OK) { goto error; } } - if (cd->compDictObj) { - if (SetDeflateDictionary(&cd->outStream, cd->compDictObj) != Z_OK) { + if (chanDataPtr->compDictObj) { + if (SetDeflateDictionary(&chanDataPtr->outStream, + chanDataPtr->compDictObj) != Z_OK) { goto error; } } } - chan = Tcl_StackChannel(interp, &zlibChannelType, cd, + chan = Tcl_StackChannel(interp, &zlibChannelType, chanDataPtr, Tcl_GetChannelMode(channel), channel); if (chan == NULL) { goto error; } - cd->chan = chan; - cd->parent = Tcl_GetStackedChannel(chan); - Tcl_SetObjResult(interp, Tcl_NewStringObj(Tcl_GetChannelName(chan), -1)); + chanDataPtr->chan = chan; + chanDataPtr->parent = Tcl_GetStackedChannel(chan); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + Tcl_GetChannelName(chan), TCL_AUTO_LENGTH)); return chan; error: - if (cd->inBuffer) { - Tcl_Free(cd->inBuffer); - inflateEnd(&cd->inStream); + if (chanDataPtr->inBuffer) { + Tcl_Free(chanDataPtr->inBuffer); + inflateEnd(&chanDataPtr->inStream); } - if (cd->outBuffer) { - Tcl_Free(cd->outBuffer); - deflateEnd(&cd->outStream); + if (chanDataPtr->outBuffer) { + Tcl_Free(chanDataPtr->outBuffer); + deflateEnd(&chanDataPtr->outStream); } - if (cd->compDictObj) { - Tcl_DecrRefCount(cd->compDictObj); + if (chanDataPtr->compDictObj) { + Tcl_DecrRefCount(chanDataPtr->compDictObj); } - Tcl_Free(cd); + Tcl_Free(chanDataPtr); return NULL; } @@ -3853,18 +3885,19 @@ ZlibStackChannelTransform( * in our buffer (buf) up to toRead bytes. * * Result: - * Number of bytes decompressed or -1 if error (with *errorCodePtr updated with reason). + * Number of bytes decompressed or -1 if error (with *errorCodePtr updated + * with reason). * * Side effects: - * After execution it updates cd->inStream (next_in, avail_in) to reflect - * the data that has been decompressed. + * After execution it updates chanDataPtr->inStream (next_in, avail_in) to + * reflect the data that has been decompressed. * *---------------------------------------------------------------------- */ static int ResultDecompress( - ZlibChannelData *cd, + ZlibChannelData *chanDataPtr, char *buf, int toRead, int flush, @@ -3873,20 +3906,25 @@ ResultDecompress( int e, written, resBytes = 0; Tcl_Obj *errObj; + chanDataPtr->flags &= ~STREAM_DECOMPRESS; + chanDataPtr->inStream.next_out = (Bytef *) buf; + chanDataPtr->inStream.avail_out = toRead; + while (chanDataPtr->inStream.avail_out > 0) { + e = inflate(&chanDataPtr->inStream, flush); - cd->flags &= ~STREAM_DECOMPRESS; - cd->inStream.next_out = (Bytef *) buf; - cd->inStream.avail_out = toRead; - while (cd->inStream.avail_out > 0) { + /* + * Apply a compression dictionary if one is needed and we have one. + */ - e = inflate(&cd->inStream, flush); - if (e == Z_NEED_DICT && cd->compDictObj) { - e = SetInflateDictionary(&cd->inStream, cd->compDictObj); + if (e == Z_NEED_DICT && chanDataPtr->compDictObj) { + e = SetInflateDictionary(&chanDataPtr->inStream, + chanDataPtr->compDictObj); if (e == Z_OK) { /* - * A repetition of Z_NEED_DICT is just an error. + * A repetition of Z_NEED_DICT now is just an error. */ - e = inflate(&cd->inStream, flush); + + e = inflate(&chanDataPtr->inStream, flush); } } @@ -3895,14 +3933,14 @@ ResultDecompress( * "toRead - avail_out" is the amount of bytes generated. */ - written = toRead - cd->inStream.avail_out; + written = toRead - chanDataPtr->inStream.avail_out; /* * The cases where we're definitely done. */ if (e == Z_STREAM_END) { - cd->flags |= STREAM_DONE; + chanDataPtr->flags |= STREAM_DONE; resBytes += written; break; } @@ -3934,16 +3972,17 @@ ResultDecompress( * Check if the inflate stopped early. */ - if (cd->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) { + if (chanDataPtr->inStream.avail_in <= 0 && flush != Z_SYNC_FLUSH) { break; } } - if (!(cd->flags & STREAM_DONE)) { + if (!HaveFlag(chanDataPtr, STREAM_DONE)) { /* if we have pending input data, but no available output buffer */ - if (cd->inStream.avail_in && !cd->inStream.avail_out) { + if (chanDataPtr->inStream.avail_in + && !chanDataPtr->inStream.avail_out) { /* next time try to decompress it got readable (new output buffer) */ - cd->flags |= STREAM_DECOMPRESS; + chanDataPtr->flags |= STREAM_DECOMPRESS; } } @@ -3951,12 +3990,13 @@ ResultDecompress( handleError: errObj = Tcl_NewListObj(0, NULL); - Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj("-errorcode",-1)); + Tcl_ListObjAppendElement(NULL, errObj, Tcl_NewStringObj( + "-errorcode", TCL_AUTO_LENGTH)); Tcl_ListObjAppendElement(NULL, errObj, - ConvertErrorToList(e, cd->inStream.adler)); + ConvertErrorToList(e, chanDataPtr->inStream.adler)); Tcl_ListObjAppendElement(NULL, errObj, - Tcl_NewStringObj(cd->inStream.msg, -1)); - Tcl_SetChannelError(cd->parent, errObj); + Tcl_NewStringObj(chanDataPtr->inStream.msg, TCL_AUTO_LENGTH)); + Tcl_SetChannelError(chanDataPtr->parent, errObj); *errorCodePtr = EINVAL; return -1; } @@ -3979,7 +4019,8 @@ TclZlibInit( * commands. */ - Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", TCL_INDEX_NONE, 0); + Tcl_EvalEx(interp, "namespace eval ::tcl::zlib {variable cmdcounter 0}", + TCL_AUTO_LENGTH, 0); /* * Create the public scripted interface to this file's functionality. @@ -4030,7 +4071,8 @@ Tcl_ZlibStreamInit( Tcl_ZlibStream *zshandle) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unimplemented", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", (char *)NULL); } return TCL_ERROR; @@ -4098,7 +4140,8 @@ Tcl_ZlibDeflate( Tcl_Obj *gzipHeaderDictObj) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unimplemented", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", (char *)NULL); } return TCL_ERROR; @@ -4113,7 +4156,8 @@ Tcl_ZlibInflate( Tcl_Obj *gzipHeaderDictObj) { if (interp) { - Tcl_SetObjResult(interp, Tcl_NewStringObj("unimplemented", -1)); + Tcl_SetObjResult(interp, Tcl_NewStringObj( + "unimplemented", TCL_AUTO_LENGTH)); Tcl_SetErrorCode(interp, "TCL", "UNIMPLEMENTED", (char *)NULL); } return TCL_ERROR; diff --git a/library/http/http.tcl b/library/http/http.tcl index 1cf24b5..d53ecef 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.10b3 namespace eval http { # Allow resourcing to not clobber existing data diff --git a/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 2428d53..0a872a7 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.10b3 [list tclPkgSetup $dir http 2.10b3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] diff --git a/library/init.tcl b/library/init.tcl index 1209619..72d0e75 100644 --- a/library/init.tcl +++ b/library/init.tcl @@ -15,7 +15,7 @@ # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -package require -exact tcl 9.0b2 +package require -exact tcl 9.0b3 # Compute the auto path to use in this interpreter. # The values on the path come from several locations: @@ -109,17 +109,15 @@ if {[interp issafe]} { # Set up the 'clock' ensemble - proc clock args { + apply {{} { set cmdmap [dict create] foreach cmd {add clicks format microseconds milliseconds scan seconds} { dict set cmdmap $cmd ::tcl::clock::$cmd } namespace inscope ::tcl::clock [list namespace ensemble create -command \ - [uplevel 1 [list ::namespace origin [::lindex [info level 0] 0]]] \ - -map $cmdmap] + ::clock -map $cmdmap] ::tcl::unsupported::clock::configure -init-complete - uplevel 1 [info level 0] - } + }} } # Conditionalize for presence of exec. diff --git a/library/manifest.txt b/library/manifest.txt index ab8bb15..584dd91 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.10b3 {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/library/tclIndex b/library/tclIndex index 2d4a957..871298f 100644 --- a/library/tclIndex +++ b/library/tclIndex @@ -95,7 +95,7 @@ set auto_index(::safe::RejectExcessColons) [list ::tcl::Pkg::source [file join $ set auto_index(::safe::VarName) [list ::tcl::Pkg::source [file join $dir safe.tcl]] set auto_index(::safe::Setup) [list ::tcl::Pkg::source [file join $dir safe.tcl]] set auto_index(::safe::setSyncMode) [list ::tcl::Pkg::source [file join $dir safe.tcl]] -set auto_index(::tcl::tmpath) [list ::tcl::Pkg::source [file join $dir tm.tcl]] +set auto_index(::tcl::tm::path) [list ::tcl::Pkg::source [file join $dir tm.tcl]] set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]] set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]] set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]] diff --git a/library/tm.tcl b/library/tm.tcl index 96bfe03..53295c8 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -97,8 +97,8 @@ proc ::tcl::tm::add {args} { set newpaths $paths foreach p $args { - if {$p in $newpaths} { - # Ignore a path already on the list. + if {($p eq "") || ($p in $newpaths)} { + # Ignore any path which is empty or already on the list. continue } @@ -335,13 +335,13 @@ proc ::tcl::tm::Defaults {} { foreach ev [::list \ TCL${major}.${n}_TM_PATH \ TCL${major}_${n}_TM_PATH \ - ] { + ] { if {![info exists env($ev)]} continue foreach p [split $env($ev) $sep] { - # Paths relative to unresolvable home dirs are ignored - if {![catch {file tildeexpand $p} expanded_path]} { - path add $expanded_path - } + # Paths relative to unresolvable home dirs are ignored + if {![catch {file tildeexpand $p} expanded_path]} { + path add $expanded_path + } } } } diff --git a/macosx/tclMacOSXNotify.c b/macosx/tclMacOSXNotify.c index 9123656..d8af241 100644 --- a/macosx/tclMacOSXNotify.c +++ b/macosx/tclMacOSXNotify.c @@ -846,7 +846,6 @@ StartNotifierThread(void) } UNLOCK_NOTIFIER_INIT; } - /* *---------------------------------------------------------------------- diff --git a/tests/clock.test b/tests/clock.test index 8072a68..0144512 100644 --- a/tests/clock.test +++ b/tests/clock.test @@ -273,6 +273,8 @@ proc ::testClock::registry { cmd path key } { # Base test cases: +# no lazy creation of clock-ensemble (interim, bug [9889f96f4da77e3b], [31fd84270644f67d]), +# so ensemble created implicitely in init.tcl test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" -setup { set i [interp create]; # because clock can be used somewhere, test it in new interp: } -body { @@ -286,7 +288,7 @@ test clock-0.1 "initial: auto-loading of ensemble and stubs on demand" -setup { } } -cleanup { interp delete $i -} -result {ens:0 ens:1 stubs:0 stubs:1} +} -result {ens:1 ens:1 stubs:0 stubs:1} test clock-0.1a "initial: safe interpreter shares clock command with parent" -setup { set i [interp create] $i eval {set sci [interp create -safe]} @@ -301,7 +303,7 @@ test clock-0.1a "initial: safe interpreter shares clock command with parent" -se } } -cleanup { interp delete $i -} -result {ens:0 ens:1 stubs:0 stubs:1} +} -result {ens:1 ens:1 stubs:0 stubs:1} test clock-0.2 "initial: loading of format/locale does not overwrite interp state (errorInfo)" -setup { # be sure - we have no cached locale/msgcat, etc: @@ -375,6 +377,10 @@ test clock-1.9 "clock arguments: option doubly present" { list [catch {clock format 0 -gmt 1 -gmt 0} result] $result } {1 {bad option "-gmt": doubly present}} +test clock-1.10 {clock format: text with token (bug [a858d95f4bfddafb])} { + clock format 0 -format text(%d) -gmt 1 +} {text(01)} + # BEGIN testcases2 # Test formatting of Gregorian year, month, day, all formats @@ -18924,6 +18930,10 @@ test clock-6.22.20 {Greedy match (second space wins as date-time separator)} { clock format [clock scan "111 2 13120" -format "%y%m%d %H%M%S" -gmt 1] -locale en -gmt 1 } {Sun Jan 02 13:12:00 GMT 2011} +test clock-6.23 {clock scan: text with token (bug [a858d95f4bfddafb])} { + clock scan {text(01)} -format text(%d) -gmt 1 -base 0 +} 0 + test clock-7.1 {Julian Day} { clock scan 0 -format %J -gmt true diff --git a/tests/cmdAH.test b/tests/cmdAH.test index ad5a67d..834fd68 100644 --- a/tests/cmdAH.test +++ b/tests/cmdAH.test @@ -22,6 +22,10 @@ testConstraint testchmod [llength [info commands testchmod]] testConstraint testsetplatform [llength [info commands testsetplatform]] testConstraint testvolumetype [llength [info commands testvolumetype]] testConstraint testbytestring [llength [info commands testbytestring]] +testConstraint time64bit [expr { + $::tcl_platform(pointerSize) >= 8 || + [llength [info command testsize]] && [testsize st_mtime] >= 8 +}] testConstraint linkDirectory [expr { ![testConstraint win] || ($::tcl_platform(osVersion) >= 5.0 @@ -1707,7 +1711,7 @@ test cmdAH-24.14.1 { } -match regexp -result {could not (?:get modification time|read)} -returnCodes error # 3155760000 is 64-bit Unix time, Wed Jan 01 00:00:00 GMT 2070: -test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setup { +test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { set filename [makeFile "" foo.text] } -body { # This test may fail if your system does not have a 64-bit time_t. @@ -1716,7 +1720,7 @@ test cmdAH-24.20.1 {Tcl_FileObjCmd: atime 64-bit time_t, bug [4718b41c56]} -setu } -cleanup { removeFile $filename } -result {3155760000 3155760000} -test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -setup { +test cmdAH-24.20.2 {Tcl_FileObjCmd: mtime 64-bit time_t, bug [4718b41c56]} -constraints {time64bit} -setup { set filename [makeFile "" foo.text] } -body { # This test may fail if your system does not have a 64-bit time_t. diff --git a/tests/io.test b/tests/io.test index 2ed97d2..49c16b7 100644 --- a/tests/io.test +++ b/tests/io.test @@ -2482,6 +2482,8 @@ test io-28.6 { } -body { variable done variable res + # Not a complete / correct channel implementation. Just enough + # to exercise the crash - closing from a write handler after 0 [list coroutine c1 apply [list {} { variable done set chan [chan create w {apply {{cmd chan args} { @@ -2489,7 +2491,7 @@ test io-28.6 { blocking - finalize { } watch { - chan postevent $chan write + lappend ::timers286 [after 0 chan postevent $chan write] } initialize { list initialize finalize watch read write configure blocking @@ -2510,6 +2512,8 @@ test io-28.6 { } [namespace current]]] vwait [namespace current]::done return success +} -cleanup { + foreach timer $::timers286 {after cancel $timer} } -result success test io-28.7 { @@ -2522,12 +2526,14 @@ test io-28.7 { variable res after 0 [list coroutine c1 apply [list {} { variable done + # Not a complete / correct channel implementation. Just enough + # to exercise the crash - closing from a read handler set chan [chan create r {apply {{cmd chan args} { switch $cmd { blocking - finalize { } watch { - chan postevent $chan read + lappend ::timers287 [after 0 chan postevent $chan read] } initialize { list initialize finalize watch read write configure blocking @@ -2548,6 +2554,8 @@ test io-28.7 { } [namespace current]]] vwait [namespace current]::done return success +} -cleanup { + foreach timer $::timers287 {after cancel $timer} } -result success test io-29.1 {Tcl_WriteChars, channel not writable} { diff --git a/tests/ioCmd.test b/tests/ioCmd.test index dfa7d06..e8a9c57 100644 --- a/tests/ioCmd.test +++ b/tests/ioCmd.test @@ -496,14 +496,14 @@ test iocmd-12.10 {POSIX open access modes: BINARY} { close $f set result } 5 -test iocmd-12.11 {POSIX open access modes: BINARY} -body { +test iocmd-12.10.1 {POSIX open access modes: BINARY} -body { after 100 set f [open $path(test1) {WRONLY BINARY TRUNC}] puts $f Ɉ ;# throws an exception } -cleanup { close $f } -returnCodes 1 -match glob -result {error writing "*": invalid or incomplete multibyte or wide character} -test iocmd-12.12 {POSIX open access modes: BINARY} { +test iocmd-12.11 {POSIX open access modes: BINARY} { set f [open $path(test1) {WRONLY BINARY TRUNC}] puts $f H close $f @@ -2178,6 +2178,74 @@ test iocmd-32.2 {delete interp of reflected chan} { interp delete child } {} +# 1st attempt without error in write, another with error in write: +foreach ::writeErr {0 1} { +test iocmd-32.3.$::writeErr {prevent copy-state against segfault by finalize, bug [79474c58800cdf94]} -setup { + proc test_chan {args} { + set rest [lassign $args mode chan] + lappend ::ret $mode + switch -exact $mode { + read {puts $chan "Test" ; close $chan} + write {if {$::writeErr} {return "boom"}; set data [lindex $rest 0]; string length $data} + finalize {after 20 {set ::done done}} + initialize {return "initialize watch finalize read write"} + } + } + set clchlst {} + set toev [after 5000 {set ::done tout}] +} -body { + set ::ret {} + set ch [chan create "read write" test_chan] + lappend clchlst $ch + + lassign [chan pipe] in1 out1 + lappend clchlst $in1 $out1 + lassign [chan pipe] in2 out2 + lappend clchlst $in2 $out2 + lassign [chan pipe] in3 out3 + lappend clchlst $in3 $out3 + + # simulate exec: echo test >@ $out2 2>@ $out3 <@ $in1 &: + fileevent $out2 writable [list apply {{cho che} { + puts $cho test; close $cho; close $che + }} $out2 $out3] + # recopy to given chans in handler + fileevent $in2 readable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $in readable {} + } + }} $in2 $ch] + fileevent $in3 readable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $in readable {} + } + }} $in3 $ch] + fileevent $out1 writable [list apply {{in out} { + if {[catch { + chan copy $in $out + } msg]} { + #puts err:$msg + fileevent $out writable {} + } + }} $ch $out1] + + vwait ::done + lappend ::ret $::done +} -cleanup { + foreach ch $clchlst { + catch {close $ch} + } + after cancel $toev + unset -nocomplain ::done ::ret ch in1 in2 in3 out1 out2 out3 toev clchlst +} -result {initialize read write finalize done} +}; unset ::writeErr + # ### ### ### ######### ######### ######### ## Same tests as above, but exercising the code forwarding and ## receiving driver operations to the originator thread. diff --git a/tests/oo.test b/tests/oo.test index cf8b710..3077525 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -2783,6 +2783,30 @@ test oo-17.14 {OO: instance method unexport (bug 900cb0284bc)} -setup { o destroy c destroy } -result $stdmethods +test oo-17.15 {OO: class method list without -all (bug 36e5517a6850)} -setup { + oo::class create c +} -body { + oo::define c { + method foo {} {} + method Bar {} {} + private method gorp {} {} + } + list [lsort [info class methods c]] [lsort [info class methods c -private]] +} -cleanup { + c destroy +} -result {foo {Bar foo}} +test oo-17.16 {OO: instance method list without -all (bug 36e5517a6850)} -setup { + oo::object create o +} -body { + oo::objdefine o { + method foo {} {} + method Bar {} {} + private method gorp {} {} + } + list [lsort [info object methods o]] [lsort [info object methods o -private]] +} -cleanup { + o destroy +} -result {foo {Bar foo}} test oo-18.1 {OO: define command support} { @@ -3441,6 +3465,121 @@ test oo-22.2 {OO and info frame: Bug 3001438} -setup { } -match glob -cleanup { c destroy } -result {* cmd {info frame 0} method test class ::c level 0} +# Common code for oo-22.{3,4,5,6} +oo::class create WorkerBase +oo::class create WorkerSupport { + superclass oo::class WorkerBase + variable result stop + method WithWorkers {nworkers args script} { + set workers {} + try { + for {set n 1} {$n <= $nworkers} {incr n} { + lappend workers [set worker [[self] new]] + $worker schedule {*}$args + } + return [uplevel 1 $script] + } finally { + foreach worker $workers {$worker destroy} + } + } + method run {nworkers} { + set result {} + set stopvar [my varname stop] + set stop false + my WithWorkers $nworkers [list my Work [my varname result]] { + after idle [namespace code {set stop true}] + vwait $stopvar + } + return $result + } +} +oo::class create Worker { + superclass WorkerBase + method schedule {args} { + set coro [namespace current]::coro + if {![llength [info commands $coro]]} { + coroutine $coro {*}$args + } + } + method Work args {error unimplemented} + method dump {} { + info frame [expr {[info frame] - 1}] + } +} +test oo-22.3 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly restored pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } + } + A run 2 +} -cleanup { + catch {rename dump {}} + catch {A destroy} +} -match glob -result {{* method Work class ::A *} {* method Work class ::A *}} +test oo-22.4 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } + } + # Copies the methods, changing the declarer + # Test it works with the source class still around + oo::copy A B + B run 2 +} -cleanup { + catch {rename dump {}} + catch {A destroy} + catch {B destroy} +} -match glob -result {{* method Work class ::B *} {* method Work class ::B *}} +test oo-22.5 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } + } + # Copies the methods, changing the declarer + # Test it works with the source class deleted + oo::copy A B + catch {A destroy} + B run 2 +} -cleanup { + catch {rename dump {}} + catch {B destroy} +} -match glob -result {{* method Work class ::B *} {* method Work class ::B *}} +test oo-22.6 {OO and coroutines and info frame: Bug 87271f7cd6} -body { + # Triggers a crash with incorrectly cloned pmPtr->procPtr->cmdPtr + WorkerSupport create A { + superclass Worker + method Work {var} { + after 0 [info coroutine] + yield + lappend $var [my dump] + } + } + # Copies the methods, changing the declarer + # Test it works in the original source class with the copy around + oo::copy A B + B run 2 + A run 2 +} -cleanup { + catch {rename dump {}} + catch {A destroy} + catch {B destroy} +} -match glob -result {{* method Work class ::A *} {* method Work class ::A *}} +WorkerBase destroy # Prove that the issue in [Bug 1865054] isn't an issue any more test oo-23.1 {Self-like derivation; complex case!} -setup { @@ -4402,7 +4541,112 @@ test oo-35.6 { } -cleanup { rename obj {} } -result done - +test oo-35.7.1 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { + oo::class create base + oo::class create RpcClient { + superclass base + method write name { + lappend ::result "RpcClient -> $name" + } + method create_bug {} { + MkObjectRpc create cfg [self] 111 + } + } + oo::class create MkObjectRpc { + superclass base + variable hdl + constructor {rpcHdl mqHdl} { + set hdl $mqHdl + oo::objdefine [self] forward rpc $rpcHdl + } + destructor { + my rpc write otto-$hdl + } + } + set ::result {} +} -body { + set FH [RpcClient new] + $FH create_bug + $FH destroy + join $result \n +} -cleanup { + base destroy +} -result {} +test oo-35.7.2 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { + oo::class create base + oo::class create RpcClient { + superclass base + method write name { + lappend ::result "RpcClient -> $name" + } + method create_bug {} { + MkObjectRpc create cfg [self] 111 + } + destructor { + lappend ::result "Destroyed" + } + } + oo::class create MkObjectRpc { + superclass base + variable hdl + constructor {rpcHdl mqHdl} { + set hdl $mqHdl + oo::objdefine [self] forward rpc $rpcHdl + } + destructor { + my rpc write otto-$hdl + } + } + set ::result {} +} -body { + set FH [RpcClient new] + $FH create_bug + $FH destroy + join $result \n +} -cleanup { + base destroy +} -result {Destroyed} +test oo-35.7.3 {Bug 7842f33a5c: destructor cascading in stereotypes} -setup { + oo::class create base + oo::class create RpcClient { + superclass base + variable interiorObjects + method write name { + lappend ::result "RpcClient -> $name" + } + method create_bug {} { + set obj [MkObjectRpc create cfg [self] 111] + lappend interiorObjects $obj + return $obj + } + destructor { + lappend ::result "Destroyed" + # Explicit destroy of interior objects + foreach obj $interiorObjects { + $obj destroy + } + } + } + oo::class create MkObjectRpc { + superclass base + variable hdl + constructor {rpcHdl mqHdl} { + set hdl $mqHdl + oo::objdefine [self] forward rpc $rpcHdl + } + destructor { + my rpc write otto-$hdl + } + } + set ::result {} +} -body { + set FH [RpcClient new] + $FH create_bug + $FH destroy + join $result \n +} -cleanup { + base destroy +} -result "Destroyed\nRpcClient -> otto-111" test oo-36.1 {TIP #470: introspection within oo::define} { oo::define oo::object self } ::oo::object diff --git a/unix/Makefile.in b/unix/Makefile.in index 0495799..093edf8 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1075,9 +1075,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.10b3 as a Tcl Module" @$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl \ - "$(MODULE_INSTALL_DIR)/9.0/http-2.10b2.tm" + "$(MODULE_INSTALL_DIR)/9.0/http-2.10b3.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"; \ @@ -2449,7 +2449,6 @@ dist: $(UNIX_DIR)/configure $(UNIX_DIR)/tclConfig.h.in $(UNIX_DIR)/tcl.pc.in gen for i in `ls $(DISTROOT)/pkgs/*.tar.gz 2> /dev/null`; do \ tar -C $(DISTDIR)/pkgs -xzf "$$i"; \ done - $(DIST_INSTALL_DATA) $(TOP_DIR)/.travis.yml $(DISTDIR) $(INSTALL_DATA_DIR) $(DISTDIR)/.github/workflows $(DIST_INSTALL_DATA) $(TOP_DIR)/.github/workflows/*.yml $(DISTDIR)/.github/workflows diff --git a/unix/configure b/unix/configure index c8e5bdc..b470e3c 100755 --- a/unix/configure +++ b/unix/configure @@ -2710,7 +2710,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b2" +TCL_PATCH_LEVEL="b3" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -5205,6 +5205,9 @@ then : ZLIB_INCLUDE=-I\${ZLIB_DIR} +printf "%s\n" "#define TCL_WITH_INTERNAL_ZLIB 1" >>confdefs.h + + fi printf "%s\n" "#define HAVE_ZLIB 1" >>confdefs.h diff --git a/unix/configure.ac b/unix/configure.ac index df38377..766392e 100644 --- a/unix/configure.ac +++ b/unix/configure.ac @@ -26,7 +26,7 @@ m4_ifdef([SC_USE_CONFIG_HEADERS], [ TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b2" +TCL_PATCH_LEVEL="b3" VERSION=${TCL_VERSION} EXTRA_INSTALL_BINARIES=${EXTRA_INSTALL_BINARIES:-"@:"} @@ -165,6 +165,7 @@ AS_IF([test $zlib_ok = no], [ AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) AC_SUBST(ZLIB_SRCS,[\${ZLIB_SRCS}]) AC_SUBST(ZLIB_INCLUDE,[-I\${ZLIB_DIR}]) + AC_DEFINE(TCL_WITH_INTERNAL_ZLIB, 1, [Tcl with internal zlib]) ]) AC_DEFINE(HAVE_ZLIB, 1, [Is there an installed zlib?]) diff --git a/unix/tcl.spec b/unix/tcl.spec index 65194f6..3b68691 100644 --- a/unix/tcl.spec +++ b/unix/tcl.spec @@ -4,7 +4,7 @@ Name: tcl Summary: Tcl scripting language development environment -Version: 9.0b2 +Version: 9.0b3 Release: 2 License: BSD Group: Development/Languages diff --git a/unix/tclConfig.h.in b/unix/tclConfig.h.in index eb566dc..4785a07 100644 --- a/unix/tclConfig.h.in +++ b/unix/tclConfig.h.in @@ -447,6 +447,9 @@ /* Tcl with external libtommath */ #undef TCL_WITH_EXTERNAL_TOMMATH +/* Tcl with internal zlib */ +#undef TCL_WITH_INTERNAL_ZLIB + /* Is getcwd Posix-compliant? */ #undef USEGETWD diff --git a/unix/tclKqueueNotfy.c b/unix/tclKqueueNotfy.c index 062139a..ba49842 100644 --- a/unix/tclKqueueNotfy.c +++ b/unix/tclKqueueNotfy.c @@ -185,8 +185,7 @@ PlatformEventsControl( Tcl_Panic("fstat: %s", strerror(errno)); } else if ((fdStat.st_mode & S_IFMT) == S_IFREG || (fdStat.st_mode & S_IFMT) == S_IFDIR - || (fdStat.st_mode & S_IFMT) == S_IFLNK - ) { + || (fdStat.st_mode & S_IFMT) == S_IFLNK) { switch (op) { case EV_ADD: if (isNew) { diff --git a/unix/tclLoadNext.c b/unix/tclLoadNext.c index 12df7e4..de185fb 100644 --- a/unix/tclLoadNext.c +++ b/unix/tclLoadNext.c @@ -14,7 +14,6 @@ #include <mach-o/rld.h> #include <streams/streams.h> - /* * Static procedures defined within this file. */ diff --git a/unix/tclLoadOSF.c b/unix/tclLoadOSF.c index 1c8b53a..81f314f 100644 --- a/unix/tclLoadOSF.c +++ b/unix/tclLoadOSF.c @@ -36,7 +36,6 @@ #include <sys/types.h> #include <loader.h> - /* * Static procedures defined within this file. */ diff --git a/unix/tclUnixInit.c b/unix/tclUnixInit.c index 67bff10..81e3af5 100644 --- a/unix/tclUnixInit.c +++ b/unix/tclUnixInit.c @@ -335,7 +335,6 @@ static int MacOSXGetLibraryPath(Tcl_Interp *interp, MODULE_SCOPE long tclMacOSXDarwinRelease; long tclMacOSXDarwinRelease = 0; #endif - /* *--------------------------------------------------------------------------- diff --git a/unix/tclUnixPipe.c b/unix/tclUnixPipe.c index 939ec85..ea1636e 100644 --- a/unix/tclUnixPipe.c +++ b/unix/tclUnixPipe.c @@ -1239,12 +1239,14 @@ PipeOutputProc( * so do not pass it to directly to Tcl_CreateFileHandler. * Instead, pass a wrapper which is a Tcl_FileProc. */ + static void PipeWatchNotifyChannelWrapper( void *clientData, int mask) { Tcl_Channel channel = (Tcl_Channel)clientData; + Tcl_NotifyChannel(channel, mask); } diff --git a/win/Makefile.in b/win/Makefile.in index 14e518e..18ce10d 100644 --- a/win/Makefile.in +++ b/win/Makefile.in @@ -160,7 +160,7 @@ TEST_LOAD_PRMS = lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\ TEST_LOAD_FACILITIES = package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load ${TEST_DLL_FILE} Tcltest];\ $(TEST_LOAD_PRMS) ZLIB_DLL_FILE = zlib1.dll -TOMMATH_DLL_FILE = libtommath.dll +TOMMATH_DLL_FILE = libtommath.dll SHARED_LIBRARIES = $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@ STATIC_LIBRARIES = $(TCL_LIB_FILE) @@ -210,6 +210,7 @@ SHELL = @SHELL@ RM = rm -f COPY = cp LN = ln +GDB = gdb ### # Tip 430 - ZipFS Modifications @@ -929,8 +930,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)/9.0/http-2.10b2.tm"; + @echo "Installing package http 2.10b3 as a Tcl Module"; + @$(COPY) $(ROOT_DIR)/library/http/http.tcl "$(MODULE_INSTALL_DIR)/9.0/http-2.10b3.tm"; @echo "Installing package opt 0.4.7"; @for j in $(ROOT_DIR)/library/opt/*.tcl; do \ $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \ @@ -1025,7 +1026,16 @@ shell: binaries # This target can be used to run tclsh inside either gdb or insight gdb: binaries @echo "set env TCL_LIBRARY=$(LIBRARY_DIR)" > gdb.run - gdb ./$(TCLSH) --command=gdb.run + $(GDB) ./$(TCLSH) --command=gdb.run + rm gdb.run + +shquotequote = $(subst ',\",$(subst ",\",$(1))) +gdb-test: tcltest + @printf '%s ' 'set env TCL_LIBRARY=$(LIBRARY_DIR)' > gdb.run + @printf '\n' >>gdb.run + @printf '%s ' set args $(ROOT_DIR_NATIVE)/tests/all.tcl \ + $(call shquotequote,$(TESTFLAGS)) -singleproc 1 >> gdb.run + $(GDB) ${TEST_EXE_FILE} --command=gdb.run rm gdb.run depend: diff --git a/win/configure b/win/configure index 103e114..9d7b11c 100755 --- a/win/configure +++ b/win/configure @@ -2411,7 +2411,7 @@ SHELL=/bin/sh TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b2" +TCL_PATCH_LEVEL="b3" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -5017,6 +5017,9 @@ fi else case e in #( e) + +printf "%s\n" "#define TCL_WITH_INTERNAL_ZLIB 1" >>confdefs.h + ZLIB_OBJS=\${ZLIB_OBJS} TOMMATH_OBJS=\${TOMMATH_OBJS} diff --git a/win/configure.ac b/win/configure.ac index 9f6e21a..572c3c5 100644 --- a/win/configure.ac +++ b/win/configure.ac @@ -15,7 +15,7 @@ SHELL=/bin/sh TCL_VERSION=9.0 TCL_MAJOR_VERSION=9 TCL_MINOR_VERSION=0 -TCL_PATCH_LEVEL="b2" +TCL_PATCH_LEVEL="b3" VER=$TCL_MAJOR_VERSION$TCL_MINOR_VERSION TCL_DDE_VERSION=1.4 @@ -155,6 +155,7 @@ AS_IF([test "$tcl_ok" = "yes"], [ AC_SUBST(TOMMATH_LIBS,[\${TOMMATH_DIR_NATIVE}/win32/tommath.lib]) ]) ], [ + AC_DEFINE(TCL_WITH_INTERNAL_ZLIB, 1, [Tcl with internal zlib]) AC_SUBST(ZLIB_OBJS,[\${ZLIB_OBJS}]) AC_SUBST(TOMMATH_OBJS,[\${TOMMATH_OBJS}]) ]) diff --git a/win/makefile.vc b/win/makefile.vc index 13b5396..2a35668 100644 --- a/win/makefile.vc +++ b/win/makefile.vc @@ -470,7 +470,11 @@ LIBTCLVFS = $(OUT_DIR)\$(LIBTCLVFSSUBDIR) # Additional include and C macro definitions for the implicit rules
# defined in rules.vc
PRJ_INCLUDES = -I"$(TOMMATHDIR)"
-PRJ_DEFINES = /DTCL_TOMMATH /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS
+PRJ_DEFINES = /DMP_PREC=4 /Dinline=__inline /DHAVE_ZLIB=1 /D_CRT_SECURE_NO_DEPRECATE /D_CRT_NONSTDC_NO_DEPRECATE /DMP_FIXED_CUTOFFS
+
+!if $(STATIC_BUILD)
+PRJ_DEFINES = $(PRJ_DEFINES) /DTCL_WITH_INTERNAL_ZLIB
+!endif
# Additional Link libraries needed beyond those in rules.vc
PRJ_LIBS = netapi32.lib user32.lib userenv.lib ws2_32.lib
diff --git a/win/tclWinChan.c b/win/tclWinChan.c index 8715b4d..4c08464 100644 --- a/win/tclWinChan.c +++ b/win/tclWinChan.c @@ -108,10 +108,10 @@ static Tcl_Channel OpenFileChannel(HANDLE handle, char *channelName, static const Tcl_ChannelType fileChannelType = { "file", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Close proc. */ FileInputProc, /* Input proc. */ FileOutputProc, /* Output proc. */ - NULL, + NULL, NULL, /* Set option proc. */ FileGetOptionProc, /* Get option proc. */ FileWatchProc, /* Set up the notifier to watch the channel. */ @@ -140,7 +140,6 @@ static const Tcl_ChannelType fileChannelType = { #define POSIX_EPOCH_AS_FILETIME \ ((long long) 116444736 * (long long) 1000000000) - /* *---------------------------------------------------------------------- diff --git a/win/tclWinConsole.c b/win/tclWinConsole.c index 4ee8033..8b289b1 100644 --- a/win/tclWinConsole.c +++ b/win/tclWinConsole.c @@ -280,7 +280,6 @@ static Tcl_ThreadDataKey dataKey; */ SRWLOCK gConsoleLock; - /* Process-wide list of console handles. Access control through gConsoleLock */ static ConsoleHandleInfo *gConsoleHandleInfoList; @@ -341,7 +340,7 @@ RingBufferInit( if (capacity <= 0 || capacity > TCL_SIZE_MAX) { Tcl_Panic("Internal error: invalid ring buffer capacity requested."); } - ringPtr->bufPtr = (char *) Tcl_Alloc(capacity); + ringPtr->bufPtr = (char *)Tcl_Alloc(capacity); ringPtr->capacity = capacity; ringPtr->start = 0; ringPtr->length = 0; @@ -905,7 +904,7 @@ ConsoleCheckProc( /* See note above loop why this can be accessed without locks */ chanInfoPtr->flags |= CONSOLE_EVENT_QUEUED; chanInfoPtr->numRefs += 1; /* So it does not go away while event - is in queue */ + * is in queue */ evPtr->header.proc = ConsoleEventProc; evPtr->chanInfoPtr = chanInfoPtr; Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL); @@ -973,7 +972,7 @@ ConsoleBlockModeProc( static int ConsoleCloseProc( - void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ + void *instanceData, /* Pointer to ConsoleChannelInfo structure. */ TCL_UNUSED(Tcl_Interp *), int flags) { @@ -2006,7 +2005,7 @@ AllocateConsoleHandleInfo( ConsoleHandleInfo *handleInfoPtr; DWORD consoleMode; - handleInfoPtr = (ConsoleHandleInfo *) Tcl_Alloc(sizeof(*handleInfoPtr)); + handleInfoPtr = (ConsoleHandleInfo *)Tcl_Alloc(sizeof(*handleInfoPtr)); memset(handleInfoPtr, 0, sizeof(*handleInfoPtr)); handleInfoPtr->console = consoleHandle; InitializeSRWLock(&handleInfoPtr->lock); diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index e7164df..0af484d 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -53,7 +53,6 @@ enum { static const int attributeArray[] = {FILE_ATTRIBUTE_ARCHIVE, FILE_ATTRIBUTE_HIDDEN, 0, FILE_ATTRIBUTE_READONLY, 0, FILE_ATTRIBUTE_SYSTEM}; - const char *const tclpFileAttrStrings[] = { "-archive", "-hidden", "-longname", "-readonly", "-shortname", "-system", NULL diff --git a/win/tclWinInt.h b/win/tclWinInt.h index 6de1432..9995602 100644 --- a/win/tclWinInt.h +++ b/win/tclWinInt.h @@ -75,11 +75,10 @@ typedef struct TclPipeThreadInfo { * to do read/write operation. Additionally * used as signal to stop (state set to -1) */ volatile LONG state; /* Indicates current state of the thread */ - void *clientData; /* Referenced data of the main thread */ + void *clientData; /* Referenced data of the main thread */ HANDLE evWakeUp; /* Optional wake-up event worker set by shutdown */ } TclPipeThreadInfo; - /* If pipe-workers will use some tcl subsystem, we can use Tcl_Alloc without * more overhead for finalize thread (should be executed anyway) * @@ -99,7 +98,6 @@ typedef struct TclPipeThreadInfo { #define PTI_STATE_END 4 /* thread should stop work (worker is busy) */ #define PTI_STATE_DOWN 8 /* worker is down */ - MODULE_SCOPE TclPipeThreadInfo * TclPipeThreadCreateTI(TclPipeThreadInfo **pipeTIPtr, void *clientData, HANDLE wakeEvent); diff --git a/win/tclWinPipe.c b/win/tclWinPipe.c index 3f0269c..dbf3324 100644 --- a/win/tclWinPipe.c +++ b/win/tclWinPipe.c @@ -1187,7 +1187,6 @@ TclpCreateProcess( } return result; } - /* *---------------------------------------------------------------------- diff --git a/win/tclWinPort.h b/win/tclWinPort.h index efd9ff2..8ab4548 100644 --- a/win/tclWinPort.h +++ b/win/tclWinPort.h @@ -246,7 +246,6 @@ typedef DWORD_PTR * PDWORD_PTR; # define EWOULDBLOCK 140 /* Operation would block */ #endif - /* Visual Studio doesn't have these, so just choose some high numbers */ #ifndef ESOCKTNOSUPPORT # define ESOCKTNOSUPPORT 240 /* Socket type not supported */ @@ -415,7 +414,6 @@ typedef DWORD_PTR * PDWORD_PTR; # endif #endif /* !S_ISLNK */ - /* * Define MAXPATHLEN in terms of MAXPATH if available */ @@ -524,7 +522,6 @@ typedef DWORD_PTR * PDWORD_PTR; /* This type is not defined in the Windows headers */ #define socklen_t int - /* * The following macros have trivial definitions, allowing generic code to * address platform-specific issues. diff --git a/win/tclWinSerial.c b/win/tclWinSerial.c index d8193b4..e27937e 100644 --- a/win/tclWinSerial.c +++ b/win/tclWinSerial.c @@ -613,7 +613,6 @@ SerialCloseProc( return EINVAL; } - if (serialPtr->validMask & TCL_READABLE) { PurgeComm(serialPtr->handle, PURGE_RXABORT | PURGE_RXCLEAR); CloseHandle(serialPtr->osRead.hEvent); @@ -1480,7 +1479,6 @@ TclWinOpenSerialChannel( infoPtr->channel = Tcl_CreateChannel(&serialChannelType, channelName, infoPtr, permissions); - SetupComm(handle, infoPtr->sysBufRead, infoPtr->sysBufWrite); PurgeComm(handle, PURGE_TXABORT | PURGE_RXABORT | PURGE_TXCLEAR | PURGE_RXCLEAR); diff --git a/win/tclWinSock.c b/win/tclWinSock.c index c51d69d..761023b 100644 --- a/win/tclWinSock.c +++ b/win/tclWinSock.c @@ -62,10 +62,10 @@ #define SET_BITS(var, bits) ((var) |= (bits)) #define CLEAR_BITS(var, bits) ((var) &= ~(bits)) -#define GOT_BITS(var, bits) (((var) & (bits)) != 0) +#define GOT_BITS(var, bits) (((var) & (bits)) != 0) /* "sock" + a pointer in hex + \0 */ -#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) +#define SOCK_CHAN_LENGTH (16 + TCL_INTEGER_SPACE) /* * The following variable is used to tell whether this module has been @@ -80,12 +80,19 @@ TCL_DECLARE_MUTEX(socketMutex) /* * The following defines declare the messages used on socket windows. */ +enum TclSocketMessages { + SOCKET_MESSAGE = WM_USER+1, /* Sent by OS: something happened. */ + SOCKET_SELECT = WM_USER+2, /* Adjust select mask. */ + SOCKET_TERMINATE = WM_USER+3/* Stop worker thread. */ +}; -#define SOCKET_MESSAGE WM_USER+1 -#define SOCKET_SELECT WM_USER+2 -#define SOCKET_TERMINATE WM_USER+3 -#define SELECT TRUE -#define UNSELECT FALSE +/* + * Operations used with a SOCKET_SELECT message. + */ +enum SocketSelectOperations { + SELECT = TRUE, /* Add socket to select. */ + UNSELECT = FALSE /* Remove socket from select. */ +}; /* * This is needed to comply with the strict aliasing rules of GCC, but it also @@ -150,7 +157,7 @@ struct TcpState { struct addrinfo *myaddrlist;/* Local address. */ struct addrinfo *myaddr; /* Iterator over myaddrlist. */ int connectError; /* Cache status of async socket. */ - int cachedBlocking; /* Cache blocking mode of async socket. */ + int cachedBlocking; /* Cache blocking mode of async socket. */ volatile int notifierConnectError; /* Async connect error set by notifier thread. * This error is still a windows error code. @@ -164,21 +171,20 @@ struct TcpState { * structure. */ -#define TCP_NONBLOCKING (1<<0) /* Socket with non-blocking I/O */ -#define TCP_ASYNC_CONNECT (1<<1) /* Async connect in progress. */ -#define SOCKET_EOF (1<<2) /* A zero read happened on the - * socket. */ -#define SOCKET_PENDING (1<<3) /* A message has been sent for this - * socket */ -#define TCP_ASYNC_PENDING (1<<4) /* TcpConnect was called to - * process an async connect. This - * flag indicates that reentry is - * still pending */ -#define TCP_ASYNC_FAILED (1<<5) /* An async connect finally failed */ - -#define TCP_ASYNC_TEST_MODE (1<<8) /* Async testing activated. Do not - * automatically continue connection - * process */ +enum TcpStateFlags { + TCP_NONBLOCKING = (1<<0), /* Socket with non-blocking I/O. */ + TCP_ASYNC_CONNECT = (1<<1), /* Async connect in progress. */ + SOCKET_EOF = (1<<2), /* A zero read happened on the socket. */ + SOCKET_PENDING = (1<<3), /* A message has been sent for this socket */ + TCP_ASYNC_PENDING = (1<<4), /* TcpConnect was called to process an async + * connect. This flag indicates that reentry is + * still pending. */ + TCP_ASYNC_FAILED = (1<<5), /* An async connect finally failed. */ + + TCP_ASYNC_TEST_MODE = (1<<8)/* Async testing activated. Do not + * automatically continue connection + * process */ +}; /* * The following structure is what is added to the Tcl event queue when a @@ -201,7 +207,10 @@ typedef struct { #define TCP_BUFFER_SIZE 4096 - +/* + * Per (main) thread data, holding list of things being waited upon and the + * various handles to things doing the waiting/notification. + */ typedef struct { HWND hwnd; /* Handle to window for socket messages. */ HANDLE socketThread; /* Thread handling the window */ @@ -211,8 +220,7 @@ typedef struct { * socketThread has been initialized and has * started. */ HANDLE socketListLock; /* Win32 Event to lock the socketList */ - TcpState *pendingTcpState; - /* This socket is opened but not jet in the + TcpState *pendingTcpState; /* This socket is opened but not jet in the * list. This value is also checked by * the event structure. */ TcpState *socketList; /* Every open socket in this thread has an @@ -237,7 +245,7 @@ static void TcpAccept(TcpFdList *fds, SOCKET newSocket, address addr); static int WaitForConnect(TcpState *statePtr, int *errorCodePtr); static int WaitForSocketEvent(TcpState *statePtr, int events, int *errorCodePtr); -static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket); +static void AddSocketInfoFd(TcpState *statePtr, SOCKET socket); static int FindFDInList(TcpState *statePtr, SOCKET socket); static DWORD WINAPI SocketThread(LPVOID arg); static void TcpThreadActionProc(void *instanceData, @@ -264,7 +272,7 @@ static Tcl_DriverGetHandleProc TcpGetHandleProc; static const Tcl_ChannelType tcpChannelType = { "tcp", /* Type name. */ TCL_CHANNEL_VERSION_5, /* v5 channel */ - NULL, /* Close proc. */ + NULL, /* Old close proc. Deprecated. */ TcpInputProc, /* Input proc. */ TcpOutputProc, /* Output proc. */ NULL, /* Seek proc. */ @@ -272,7 +280,7 @@ static const Tcl_ChannelType tcpChannelType = { TcpGetOptionProc, /* Get option proc. */ TcpWatchProc, /* Initialize notifier. */ TcpGetHandleProc, /* Get OS handles out of channel. */ - TcpClose2Proc, /* Close2 proc. */ + TcpClose2Proc, /* New close2 proc. */ TcpBlockModeProc, /* Set blocking or non-blocking mode.*/ NULL, /* flush proc. */ NULL, /* handler proc. */ @@ -288,21 +296,32 @@ static const Tcl_ChannelType tcpChannelType = { static TclInitProcessGlobalValueProc InitializeHostName; static ProcessGlobalValue hostName = {0, 0, NULL, NULL, InitializeHostName, NULL, NULL}; - + /* - * Simple wrapper round the SendMessage syscall. + *---------------------------------------------------------------------- + * + * SendSelectMessage -- + * + * Simple wrapper round the SendMessage syscall with a SOCKET_SELECT + * message to add a bit of type safety. + * + *---------------------------------------------------------------------- */ - -#define SendSelectMessage(tsdPtr, message, payload) \ - SendMessageW((tsdPtr)->hwnd, SOCKET_SELECT, \ - (WPARAM) (message), (LPARAM) (payload)) - +static inline void +SendSelectMessage( + ThreadSpecificData *tsdPtr, /* Reference to this thread's worker. */ + int operation, /* Whether to add or remove from the mask. */ + TcpState *payload) /* What socket to add/remove. */ +{ + SendMessageW(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) operation, + (LPARAM) payload); +} /* * Address print debug functions */ #if 0 -void +static inline void printaddrinfo( struct addrinfo *ai, char *prefix) @@ -311,10 +330,10 @@ printaddrinfo( getnameinfo(ai->ai_addr, ai->ai_addrlen, host, sizeof(host), port, sizeof(port), - NI_NUMERICHOST|NI_NUMERICSERV); + NI_NUMERICHOST | NI_NUMERICSERV); } -void +static void printaddrinfolist( struct addrinfo *addrlist, char *prefix) @@ -348,17 +367,22 @@ InitializeHostName( Tcl_Encoding *encodingPtr) { WCHAR wbuf[256]; - DWORD length = sizeof(wbuf)/sizeof(WCHAR); + DWORD length = sizeof(wbuf) / sizeof(WCHAR); Tcl_DString ds; Tcl_DStringInit(&ds); if (GetComputerNameExW(ComputerNamePhysicalDnsFullyQualified, wbuf, &length) != 0) { /* - * Convert string from native to UTF then change to lowercase. + * Convert string from WCHAR to utf-8, then change to lowercase, + * then to system encoding. */ + Tcl_DString inDs; - Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, TCL_INDEX_NONE, &ds)); - + Tcl_DStringInit(&inDs); + Tcl_UtfToLower(Tcl_WCharToUtfDString(wbuf, TCL_INDEX_NONE, &inDs)); + Tcl_UtfToExternalDStringEx(NULL, NULL, Tcl_DStringValue(&inDs), + TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); + Tcl_DStringFree(&inDs); } else { TclInitSockets(); /* @@ -366,19 +390,13 @@ InitializeHostName( * documents gethostname() as being always adequate. */ - Tcl_DString inDs; - - Tcl_DStringInit(&inDs); - Tcl_DStringSetLength(&inDs, 256); - if (gethostname(Tcl_DStringValue(&inDs), - Tcl_DStringLength(&inDs)) == 0) { - Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&inDs), - TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); - } - Tcl_DStringFree(&inDs); + Tcl_DStringInit(&ds); + Tcl_DStringSetLength(&ds, 256); + gethostname(Tcl_DStringValue(&ds), Tcl_DStringLength(&ds)); + Tcl_DStringSetLength(&ds, strlen(Tcl_DStringValue(&ds))); } - *encodingPtr = Tcl_GetEncoding(NULL, "utf-8"); + *encodingPtr = Tcl_GetEncoding(NULL, NULL); *lengthPtr = Tcl_DStringLength(&ds); *valuePtr = (char *)Tcl_Alloc(*lengthPtr + 1); memcpy(*valuePtr, Tcl_DStringValue(&ds), *lengthPtr + 1); @@ -414,8 +432,8 @@ Tcl_GetHostName(void) * * TclInitSockets -- * - * Initialization of sockets for the thread. Also creates message - * handling window class for the process if needed. + * Initialization of sockets for the thread. Also creates message + * handling window class for the process if needed. * * Results: * Nothing. Panics on failure. @@ -433,7 +451,8 @@ TclInitSockets(void) { /* Then Per thread initialization. */ DWORD id; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); if (tsdPtr != NULL) { return; @@ -449,10 +468,10 @@ TclInitSockets(void) tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->pendingTcpState = NULL; - tsdPtr->socketList = NULL; - tsdPtr->hwnd = NULL; - tsdPtr->threadId = Tcl_GetCurrentThread(); - tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); + tsdPtr->socketList = NULL; + tsdPtr->hwnd = NULL; + tsdPtr->threadId = Tcl_GetCurrentThread(); + tsdPtr->readyEvent = CreateEventW(NULL, FALSE, FALSE, NULL); if (tsdPtr->readyEvent == NULL) { goto initFailure; } @@ -507,7 +526,8 @@ TclInitSockets(void) void TclpFinalizeSockets(void) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Careful! This is a finalizer! @@ -562,7 +582,7 @@ TclpFinalizeSockets(void) static int TcpBlockModeProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ int mode) /* The mode to set. Can be one of * TCL_MODE_BLOCKING or * TCL_MODE_NONBLOCKING. */ @@ -616,7 +636,6 @@ WaitForConnect( { int result; int oldMode; - ThreadSpecificData *tsdPtr; /* * Check if an async connect failed already and error reporting is @@ -646,7 +665,7 @@ WaitForConnect( if (GOT_BITS(statePtr->flags, TCP_ASYNC_TEST_MODE) && errorCodePtr != NULL - && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { + && GOT_BITS(statePtr->flags, TCP_NONBLOCKING)) { *errorCodePtr = EWOULDBLOCK; return -1; } @@ -666,7 +685,8 @@ WaitForConnect( * Get the statePtr lock. */ - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); WaitForSingleObject(tsdPtr->socketListLock, INFINITE); /* @@ -739,11 +759,11 @@ WaitForConnect( return -1; } - /* - * Free list lock. - */ + /* + * Free list lock. + */ - SetEvent(tsdPtr->socketListLock); + SetEvent(tsdPtr->socketListLock); /* * Background operation returns with no action as there was no connect @@ -793,7 +813,7 @@ WaitForConnect( static int TcpInputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ char *buf, /* Where to store data read. */ int bufSize, /* How much space is available in the * buffer? */ @@ -802,7 +822,8 @@ TcpInputProc( TcpState *statePtr = (TcpState *)instanceData; int bytesRead; DWORD error; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -884,7 +905,7 @@ TcpInputProc( */ if (GOT_BITS(statePtr->flags, TCP_NONBLOCKING) - || (error != WSAEWOULDBLOCK)) { + || (error != WSAEWOULDBLOCK)) { Tcl_WinConvertError(error); *errorCodePtr = Tcl_GetErrno(); bytesRead = -1; @@ -926,7 +947,7 @@ TcpInputProc( static int TcpOutputProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ const char *buf, /* The data buffer. */ int toWrite, /* How many bytes to write? */ int *errorCodePtr) /* Where to store error code. */ @@ -934,7 +955,8 @@ TcpOutputProc( TcpState *statePtr = (TcpState *)instanceData; int written; DWORD error; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); *errorCodePtr = 0; @@ -1030,7 +1052,7 @@ TcpOutputProc( static int TcpCloseProc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ TCL_UNUSED(Tcl_Interp *)) { TcpState *statePtr = (TcpState *)instanceData; @@ -1056,10 +1078,10 @@ TcpCloseProc( } if (statePtr->addrlist != NULL) { - freeaddrinfo(statePtr->addrlist); + freeaddrinfo(statePtr->addrlist); } if (statePtr->myaddrlist != NULL) { - freeaddrinfo(statePtr->myaddrlist); + freeaddrinfo(statePtr->myaddrlist); } /* @@ -1116,7 +1138,7 @@ TcpCloseProc( static int TcpClose2Proc( - void *instanceData, /* The socket to close. */ + void *instanceData, /* The socket to close. */ Tcl_Interp *interp, /* For error reporting. */ int flags) /* Flags that indicate which side to close. */ { @@ -1128,7 +1150,7 @@ TcpClose2Proc( * Shutdown the OS socket handle. */ - if ((flags & (TCL_CLOSE_READ|TCL_CLOSE_WRITE)) == 0) { + if ((flags & (TCL_CLOSE_READ | TCL_CLOSE_WRITE)) == 0) { return TcpCloseProc(instanceData, interp); } @@ -1137,11 +1159,13 @@ TcpClose2Proc( * TCL_WRITABLE so this should never be called for a server socket. */ - if ((flags & TCL_CLOSE_READ) && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { + if ((flags & TCL_CLOSE_READ) + && (shutdown(statePtr->sockets->fd, SD_RECEIVE) == SOCKET_ERROR)) { Tcl_WinConvertError((DWORD) WSAGetLastError()); readError = Tcl_GetErrno(); } - if ((flags & TCL_CLOSE_WRITE) && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { + if ((flags & TCL_CLOSE_WRITE) + && (shutdown(statePtr->sockets->fd, SD_SEND) == SOCKET_ERROR)) { Tcl_WinConvertError((DWORD) WSAGetLastError()); writeError = Tcl_GetErrno(); } @@ -1166,7 +1190,7 @@ TcpClose2Proc( static int TcpSetOptionProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to set. */ const char *value) /* New value for option. */ @@ -1249,7 +1273,7 @@ TcpSetOptionProc( static int TcpGetOptionProc( - void *instanceData, /* Socket state. */ + void *instanceData, /* Socket state. */ Tcl_Interp *interp, /* For error reporting - can be NULL. */ const char *optionName, /* Name of the option to retrieve the value * for, or NULL to get all options and their @@ -1263,6 +1287,9 @@ TcpGetOptionProc( size_t len = 0; int reverseDNS = 0; #define SUPPRESS_RDNS_VAR "::tcl::unsupported::noReverseDNS" +#define HAVE_OPTION(option) \ + ((len > 1) && (optionName[1] == option[1]) && \ + (strncmp(optionName, option, len) == 0)) /* * Go one step in async connect @@ -1280,8 +1307,7 @@ TcpGetOptionProc( len = strlen(optionName); } - if ((len > 1) && (optionName[1] == 'e') && - (strncmp(optionName, "-error", len) == 0)) { + if (HAVE_OPTION("-error")) { /* * Do not return any errors if async connect is running. */ @@ -1296,7 +1322,8 @@ TcpGetOptionProc( if (statePtr->connectError != 0) { Tcl_DStringAppend(dsPtr, - Tcl_ErrnoMsg(statePtr->connectError), TCL_INDEX_NONE); + Tcl_ErrnoMsg(statePtr->connectError), + TCL_INDEX_NONE); statePtr->connectError = 0; } } else { @@ -1331,19 +1358,19 @@ TcpGetOptionProc( if (err) { Tcl_WinConvertError(err); - Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), TCL_INDEX_NONE); + Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), + TCL_INDEX_NONE); } } } return TCL_OK; } - if ((len > 1) && (optionName[1] == 'c') && - (strncmp(optionName, "-connecting", len) == 0)) { + if (HAVE_OPTION("-connecting")) { Tcl_DStringAppend(dsPtr, GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING) ? "1" : "0", TCL_INDEX_NONE); - return TCL_OK; + return TCL_OK; } if (interp != NULL @@ -1351,8 +1378,7 @@ TcpGetOptionProc( reverseDNS = NI_NUMERICHOST; } - if ((len == 0) || ((len > 1) && (optionName[1] == 'p') && - (strncmp(optionName, "-peername", len) == 0))) { + if (HAVE_OPTION("-peername")) { address peername; socklen_t size = sizeof(peername); @@ -1410,8 +1436,7 @@ TcpGetOptionProc( } } - if ((len == 0) || ((len > 1) && (optionName[1] == 's') && - (strncmp(optionName, "-sockname", len) == 0))) { + if ((len == 0) || HAVE_OPTION("-sockname")) { TcpFdList *fds; address sockname; socklen_t size; @@ -1483,8 +1508,7 @@ TcpGetOptionProc( } } - if ((len == 0) || ((len > 1) && (optionName[1] == 'k') && - (strncmp(optionName, "-keepalive", len) == 0))) { + if ((len == 0) || HAVE_OPTION("-keepalive")) { int optlen; BOOL opt = FALSE; @@ -1500,8 +1524,7 @@ TcpGetOptionProc( } } - if ((len == 0) || ((len > 1) && (optionName[1] == 'n') && - (strncmp(optionName, "-nodelay", len) == 0))) { + if ((len == 0) || HAVE_OPTION("-nodelay")) { int optlen; BOOL opt = FALSE; @@ -1545,7 +1568,7 @@ TcpGetOptionProc( static void TcpWatchProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ int mask) /* Events of interest; an OR-ed combination of * TCL_READABLE, TCL_WRITABLE and * TCL_EXCEPTION. */ @@ -1599,9 +1622,9 @@ TcpWatchProc( static int TcpGetHandleProc( - void *instanceData, /* The socket state. */ + void *instanceData, /* The socket state. */ TCL_UNUSED(int) /*direction*/, - void **handlePtr) /* Where to store the handle. */ + void **handlePtr) /* Where to store the handle. */ { TcpState *statePtr = (TcpState *)instanceData; @@ -1623,9 +1646,9 @@ TcpGetHandleProc( * connect synchronously * * Results: - * TCL_OK, if the socket was successfully connected or an asynchronous - * connection is in progress. If an error occurs, TCL_ERROR is returned - * and an error message is left in interp. + * TCL_OK, if the socket was successfully connected or an asynchronous + * connection is in progress. If an error occurs, TCL_ERROR is returned + * and an error message is left in interp. * * Side effects: * Opens a socket. @@ -1652,16 +1675,17 @@ TcpConnect( { DWORD error; int async_connect = GOT_BITS(statePtr->flags, TCP_ASYNC_CONNECT); - /* We are started with async connect and the - * connect notification was not yet - * received. */ + /* We are started with async connect and the + * connect notification was not yet + * received. */ int async_callback = GOT_BITS(statePtr->flags, TCP_ASYNC_PENDING); - /* We were called by the event procedure and - * continue our loop. */ - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + /* We were called by the event procedure and + * continue our loop. */ + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); if (async_callback) { - goto reenter; + goto reenter; } for (statePtr->addr = statePtr->addrlist; statePtr->addr != NULL; @@ -1678,10 +1702,10 @@ TcpConnect( continue; } - /* - * Close the socket if it is still open from the last unsuccessful - * iteration. - */ + /* + * Close the socket if it is still open from the last unsuccessful + * iteration. + */ if (statePtr->sockets->fd != INVALID_SOCKET) { closesocket(statePtr->sockets->fd); @@ -1994,16 +2018,16 @@ Tcl_OpenTcpClient( */ if (!TclCreateSocketAddress(interp, &addrlist, host, port, 0, &errorMsg) - || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, - &errorMsg)) { - if (addrlist != NULL) { - freeaddrinfo(addrlist); - } - if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( - "couldn't open socket: %s", errorMsg)); - } - return NULL; + || !TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, + &errorMsg)) { + if (addrlist != NULL) { + freeaddrinfo(addrlist); + } + if (interp != NULL) { + Tcl_SetObjResult(interp, Tcl_ObjPrintf( + "couldn't open socket: %s", errorMsg)); + } + return NULL; } statePtr = NewSocketInfo(INVALID_SOCKET); @@ -2056,13 +2080,10 @@ Tcl_Channel Tcl_MakeTcpClientChannel( void *sock) /* The socket to wrap up into a channel. */ { - TcpState *statePtr; - char channelName[SOCK_CHAN_LENGTH]; - ThreadSpecificData *tsdPtr; - TclInitSockets(); - tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Set kernel space buffering and non-blocking. @@ -2070,7 +2091,7 @@ Tcl_MakeTcpClientChannel( TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE); - statePtr = NewSocketInfo((SOCKET) sock); + TcpState *statePtr = NewSocketInfo((SOCKET) sock); /* * Start watching for read/write events on the socket. @@ -2079,6 +2100,7 @@ Tcl_MakeTcpClientChannel( statePtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE; SendSelectMessage(tsdPtr, SELECT, statePtr); + char channelName[SOCK_CHAN_LENGTH]; TclWinGenerateChannelName(channelName, "sock", statePtr); statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName, statePtr, (TCL_READABLE | TCL_WRITABLE)); @@ -2109,8 +2131,8 @@ Tcl_OpenTcpServerEx( const char *service, /* Port number to open. */ const char *myHost, /* Name of local host. */ unsigned int flags, /* Flags. */ - int backlog, /* Length of OS listen backlog queue, or -1 - * for default. */ + int backlog, /* Length of OS listen backlog queue, or -1 + * for default. */ Tcl_TcpAcceptProc *acceptProc, /* Callback for accepting connections from new * clients. */ @@ -2144,7 +2166,7 @@ Tcl_OpenTcpServerEx( for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) { sock = socket(addrPtr->ai_family, addrPtr->ai_socktype, - addrPtr->ai_protocol); + addrPtr->ai_protocol); if (sock == INVALID_SOCKET) { Tcl_WinConvertError((DWORD) WSAGetLastError()); continue; @@ -2221,9 +2243,9 @@ Tcl_OpenTcpServerEx( * different, and there may be differences between TCP/IP stacks). */ - if (backlog < 0) { - backlog = SOMAXCONN; - } + if (backlog < 0) { + backlog = SOMAXCONN; + } if (listen(sock, backlog) == SOCKET_ERROR) { Tcl_WinConvertError((DWORD) WSAGetLastError()); closesocket(sock); @@ -2247,7 +2269,8 @@ Tcl_OpenTcpServerEx( } if (statePtr != NULL) { - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); statePtr->acceptProc = acceptProc; statePtr->acceptProcData = acceptProcData; @@ -2276,7 +2299,7 @@ Tcl_OpenTcpServerEx( } if (interp != NULL) { - Tcl_SetObjResult(interp, Tcl_ObjPrintf( + Tcl_SetObjResult(interp, Tcl_ObjPrintf( "couldn't open socket: %s", (errorMsg ? errorMsg : Tcl_PosixError(interp)))); } @@ -2314,7 +2337,8 @@ TcpAccept( int len = sizeof(addr); char channelName[SOCK_CHAN_LENGTH]; char host[NI_MAXHOST], port[NI_MAXSERV]; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Win-NT has a misfeature that sockets are inherited in child processes @@ -2541,7 +2565,7 @@ SocketCheckProc( statePtr = statePtr->nextPtr) { if (GOT_BITS(statePtr->readyEvents, statePtr->watchEvents | FD_CONNECT | FD_ACCEPT) - && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { + && !GOT_BITS(statePtr->flags, SOCKET_PENDING)) { SET_BITS(statePtr->flags, SOCKET_PENDING); evPtr = (SocketEvent *)Tcl_Alloc(sizeof(SocketEvent)); evPtr->header.proc = SocketEventProc; @@ -2609,7 +2633,7 @@ SocketEventProc( */ if (!statePtr) { - SetEvent(tsdPtr->socketListLock); + SetEvent(tsdPtr->socketListLock); return 1; } @@ -2841,8 +2865,7 @@ AddSocketInfoFd( fds->statePtr = statePtr; fds->next = NULL; } - - + /* *---------------------------------------------------------------------- * @@ -2860,7 +2883,8 @@ AddSocketInfoFd( */ static TcpState * -NewSocketInfo(SOCKET socket) +NewSocketInfo( + SOCKET socket) { TcpState *statePtr = (TcpState *)Tcl_Alloc(sizeof(TcpState)); @@ -2897,15 +2921,15 @@ NewSocketInfo(SOCKET socket) static int WaitForSocketEvent( - TcpState *statePtr, /* Information about this socket. */ + TcpState *statePtr, /* Information about this socket. */ int events, /* Events to look for. May be one of - * FD_READ or FD_WRITE. - */ + * FD_READ or FD_WRITE. */ int *errorCodePtr) /* Where to store errors? */ { int result = 1; int oldMode; - ThreadSpecificData *tsdPtr = (ThreadSpecificData *)TclThreadDataKeyGet(&dataKey); + ThreadSpecificData *tsdPtr = (ThreadSpecificData *) + TclThreadDataKeyGet(&dataKey); /* * Be sure to disable event servicing so we are truly modal. @@ -3032,7 +3056,6 @@ SocketThread( return msg.wParam; } - /* *---------------------------------------------------------------------- diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 753fe12..8832235 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -463,7 +463,7 @@ TestplatformChmod( goto done; } aceEntry[nSids].sidLen = GetLengthSid(pTokenUser->User.Sid); - aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen); + aceEntry[nSids].pSid = (PSID)Tcl_Alloc(aceEntry[nSids].sidLen); if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenUser->User.Sid)) { Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ @@ -505,7 +505,7 @@ TestplatformChmod( goto done; } aceEntry[nSids].sidLen = GetLengthSid(pTokenGroup->PrimaryGroup); - aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen); + aceEntry[nSids].pSid = (PSID)Tcl_Alloc(aceEntry[nSids].sidLen); if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pTokenGroup->PrimaryGroup)) { Tcl_Free(pTokenGroup); Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ @@ -535,7 +535,7 @@ TestplatformChmod( goto done; } aceEntry[nSids].sidLen = GetLengthSid(pWorldSid); - aceEntry[nSids].pSid = Tcl_Alloc(aceEntry[nSids].sidLen); + aceEntry[nSids].pSid = (PSID)Tcl_Alloc(aceEntry[nSids].sidLen); if (!CopySid(aceEntry[nSids].sidLen, aceEntry[nSids].pSid, pWorldSid)) { LocalFree(pWorldSid); Tcl_Free(aceEntry[nSids].pSid); /* Since we have not ++'ed nSids */ diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c index d99de8c..d5c582b 100644 --- a/win/tclWinThrd.c +++ b/win/tclWinThrd.c @@ -79,10 +79,10 @@ static CRITICAL_SECTION joinLock; #if TCL_THREADS typedef struct ThreadSpecificData { - HANDLE condEvent; /* Per-thread condition event */ + HANDLE condEvent; /* Per-thread condition event */ struct ThreadSpecificData *nextPtr; /* Queue pointers */ struct ThreadSpecificData *prevPtr; - int flags; /* See flags below */ + int flags; /* See flags below */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -120,7 +120,7 @@ typedef struct { static DWORD tlsKey; typedef struct { - Tcl_Mutex tlock; + Tcl_Mutex tlock; CRITICAL_SECTION wlock; } allocMutex; #endif /* USE_THREAD_ALLOC */ @@ -131,12 +131,12 @@ typedef struct { */ typedef struct { - LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */ - LPVOID lpParameter; /* Original startup data */ - unsigned int fpControl; /* Floating point control word from the + LPTHREAD_START_ROUTINE lpStartAddress; + /* Original startup routine */ + LPVOID lpParameter; /* Original startup data */ + unsigned int fpControl; /* Floating point control word from the * main thread */ } WinThread; - /* *---------------------------------------------------------------------- @@ -567,9 +567,9 @@ Tcl_MutexLock( */ if (*mutexPtr == NULL) { - csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION)); + csPtr = (CRITICAL_SECTION *) Tcl_Alloc(sizeof(CRITICAL_SECTION)); InitializeCriticalSection(csPtr); - *mutexPtr = (Tcl_Mutex)csPtr; + *mutexPtr = (Tcl_Mutex) csPtr; TclRememberMutex(mutexPtr); } TclpGlobalUnlock(); @@ -659,7 +659,7 @@ void Tcl_ConditionWait( Tcl_Condition *condPtr, /* Really (WinCondition **) */ Tcl_Mutex *mutexPtr, /* Really (CRITICAL_SECTION **) */ - const Tcl_Time *timePtr) /* Timeout on waiting period */ + const Tcl_Time *timePtr) /* Timeout on waiting period */ { WinCondition *winCondPtr; /* Per-condition queue head */ CRITICAL_SECTION *csPtr; /* Caller's Mutex, after casting */ @@ -926,9 +926,6 @@ TclpFinalizeCondition( } } - - - /* * Additions by AOL for specialized thread memory allocator. */ @@ -1030,7 +1027,6 @@ TclpFreeAllocCache( } #endif /* USE_THREAD_ALLOC */ - void * TclpThreadCreateKey(void) { diff --git a/win/tclWinTime.c b/win/tclWinTime.c index 77f7547..5636dc0 100644 --- a/win/tclWinTime.c +++ b/win/tclWinTime.c @@ -103,7 +103,6 @@ static struct { double microsecsScale; /* Denominator scale between clock / microsecs */ } wideClick = {0, 0, 0.0}; - /* * Declarations for functions defined later in this file. */ |